152 files changed, 0 insertions, 346895 deletions
diff --git a/test/Lwp/a.lwp b/test/Lwp/a.lwp
deleted file mode 100644
index 242bba211..000000000
--- a/test/Lwp/a.lwp
+++ /dev/null
diff --git a/test/Lwp/a.txt b/test/Lwp/a.txt
deleted file mode 100644
index 789819226..000000000
--- a/test/Lwp/a.txt
+++ /dev/null
@@ -1 +0,0 @@
-a
diff --git a/test/Lwp/abcd.lwp b/test/Lwp/abcd.lwp
deleted file mode 100644
index 6dc586634..000000000
--- a/test/Lwp/abcd.lwp
+++ /dev/null
diff --git a/test/Lwp/abcd.txt b/test/Lwp/abcd.txt
deleted file mode 100644
index acbe86c7c..000000000
--- a/test/Lwp/abcd.txt
+++ /dev/null
@@ -1 +0,0 @@
-abcd
diff --git a/test/Lwp/austin.lwp b/test/Lwp/austin.lwp
deleted file mode 100644
index 7eee65178..000000000
--- a/test/Lwp/austin.lwp
+++ /dev/null
diff --git a/test/Lwp/austin.png b/test/Lwp/austin.png
deleted file mode 100644
index 8d89f0f4f..000000000
--- a/test/Lwp/austin.png
+++ /dev/null
diff --git a/test/Lwp/austin.sam b/test/Lwp/austin.sam
deleted file mode 100644
index 0582856c0..000000000
--- a/test/Lwp/austin.sam
+++ /dev/null
@@ -1,5069 +0,0 @@
-[ver]
-	4
-[sty]
-	
-[charset]
-	82
-	ANSI (Windows, IBM CP 1252)
-[PanoseFontTable]
-	6
-	5
-	Arial
-	2818
-	1030
-	514
-	514
-	1026
-	Arial Black
-	2818
-	1034
-	258
-	514
-	1026
-	Wingdings
-	1285
-	513
-	2049
-	2052
-	2055
-	MS Sans Serif
-	2818
-	1030
-	514
-	514
-	1026
-	
-	257
-	257
-	257
-	257
-	257
-	Times New Roman
-	514
-	774
-	1029
-	517
-	1027
-[recfile]
-	
-	
-	1
-	2
-	3
-	12
-	1440
-	1440
-[revisions]
-	0
-[prn]
-	HP LaserJet 2100 PCL6
-[port]
-	IR
-[lnopts]
-	2
-	Body Text
-	1
-[fldnames]
-	Field1
-	Field2
-	Field3
-	Field4
-	Field5
-	Field6
-	Field7
-	Field8
-[desc]
-	
-	
-	
-	
-	
-	1095635058
-	2
-	1095634939
-	0
-	41
-	15464
-	85027
-	209884
-	0
-	
-	
-	
-	
-	
-	
-	0
-[docopts]
-	5
-	2
-[GramStyle]
-	
-[lang]
-	2
-[fopts]
-	96
-	1
-	0
-	0
-	Continued on next page...
-	Continued from previous page...
-[tag]
-	Outline (Not 
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		<*;>.
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Outline (Inde
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		<*;>.
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Title
-	1
-	[fnt]
-		Arial Black
-		480
-		0
-		49152
-	[algn]
-		260
-		2
-		0
-		0
-		0
-	[spc]
-		33
-		0
-		2
-		0
-		338
-		2
-		100
-	[brk]
-		68
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	Heading 1
-	0
-	0
-[tag]
-	Table Text
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		0
-		0
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Number List
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		<*:>.
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Heading 3
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49153
-	[algn]
-		257
-		2
-		0
-		0
-		0
-	[spc]
-		33
-		0
-		2
-		142
-		0
-		2
-		100
-	[brk]
-		68
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	Body Text
-	0
-	0
-[tag]
-	Heading 2
-	1
-	[fnt]
-		Arial
-		240
-		0
-		49153
-	[algn]
-		257
-		2
-		0
-		0
-		0
-	[spc]
-		33
-		0
-		2
-		142
-		0
-		2
-		100
-	[brk]
-		68
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	Body Text
-	0
-	0
-[tag]
-	Heading 1
-	1
-	[fnt]
-		Arial Black
-		280
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		0
-		0
-	[spc]
-		33
-		0
-		2
-		396
-		0
-		2
-		100
-	[brk]
-		68
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	Body Text
-	0
-	0
-[tag]
-	First Line In
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		720
-		0
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Bullet 2
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		<*6>
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Bullet 1
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		<*1>
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Body Single
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		0
-		0
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Body Text
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		0
-		0
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Seq Level 1
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		1
-		<*;>.
-		0
-		2
-		1
-		0
-		2
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Seq Level 2
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		360
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		2
-		<*=>.
-		0
-		2
-		1
-		0
-		2
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Seq Level 3
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		720
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		3
-		<*:>.
-		0
-		2
-		1
-		0
-		2
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Seq Level 4
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		1080
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		4
-		<*>>.
-		0
-		2
-		1
-		0
-		2
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Seq Level 5
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		1440
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		5
-		<*<>.
-		0
-		2
-		1
-		0
-		2
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Seq Level 6
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		1800
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		6
-		<*:>)
-		0
-		2
-		1
-		0
-		2
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Seq Level 7
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		2160
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		7
-		<*>>)
-		0
-		2
-		1
-		0
-		2
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Seq Level 8
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		2520
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		8
-		<*<>)
-		0
-		2
-		1
-		0
-		2
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	Seq Level 9
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		2880
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		9
-		(<*:>)
-		0
-		2
-		1
-		0
-		2
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[tag]
-	WP Bullets
-	1
-	[fnt]
-		Times New Roman
-		240
-		0
-		49152
-	[algn]
-		257
-		2
-		0
-		360
-		360
-	[spc]
-		33
-		0
-		2
-		0
-		0
-		2
-		100
-	[brk]
-		4
-	[line]
-		0
-		0
-		2
-		4294967295
-		0
-		1
-		1
-		10
-		10
-		2
-	[spec]
-		0
-		0
-		<*1>
-		0
-		2
-		1
-		0
-		0
-		0
-		0
-	[nfmt]
-		280
-		1
-		2
-		.
-		,
-		$
-	
-	0
-	0
-[lay]
-	Standard
-	519
-	[rght]
-		16838
-		11906
-		2
-		1440
-		1440
-		2
-		1440
-		1440
-		0
-		1
-		3937208
-		1
-		0
-		2
-		1
-		1440
-		10466
-		12
-		1
-		720
-		1
-		1440
-		1
-		2160
-		1
-		2880
-		1
-		3600
-		1
-		4320
-		1
-		5040
-		1
-		5760
-		1
-		6480
-		1
-		7200
-		1
-		7920
-		1
-		8640
-	[frght]
-	[lyfrm]
-		1
-		13184
-		0
-		15398
-		11906
-		16838
-		0
-		2
-		3
-		1 0 0 0 0 0 0
-		0
-		16777215
-		0
-	[frmlay]
-		16838
-		11906
-		2
-		1440
-		648
-		2
-		15470
-		1440
-		0
-		1
-		3937208
-		0
-		0
-		0
-		1
-		1440
-		10466
-		2
-		2
-		4513
-		3
-		9026
-	[txt]
-
->
-	[hrght]
-	[lyfrm]
-		1
-		11136
-		0
-		0
-		11906
-		1440
-		0
-		2
-		3
-		1 0 0 0 0 0 0
-		0
-		16777215
-		0
-	[frmlay]
-		1440
-		11906
-		2
-		1440
-		72
-		2
-		648
-		1440
-		0
-		1
-		3937208
-		0
-		0
-		0
-		1
-		1440
-		10466
-		2
-		2
-		4513
-		3
-		9026
-	[txt]
-
->
-[elay]
-[l1]
-	0
-[edoc]
-Pride and Prejudice
-
-
-by Jane Austen
-
-
-
-
-
-Chapter 1
-
-
-
-It is a truth universally acknowledged, that a single man in
-
-possession of a good fortune, must be in want of a wife.
-
-
-However little known the feelings or views of such a man may
-
-be on his first entering a neighbourhood, this truth is so well
-
-fixed in the minds of the surrounding families, that he is considered
-
-the rightful property of some one or other of their daughters.
-
-
-"My dear Mr. Bennet," said his lady to him one day, "have you
-
-heard that Netherfield Park is let at last?"
-
-
-Mr. Bennet replied that he had not.
-
-
-"But it is," returned she; "for Mrs. Long has just been here, and
-
-she told me all about it."
-
-
-Mr. Bennet made no answer.
-
-
-"Do you not want to know who has taken it?" cried his wife
-
-impatiently.
-
-
-"YOU want to tell me, and I have no objection to hearing it."
-
-
-This was invitation enough.
-
-
-"Why, my dear, you must know, Mrs. Long says that Netherfield
-
-is taken by a young man of large fortune from the north of
-
-England; that he came down on Monday in a chaise and four to
-
-see the place, and was so much delighted with it, that he agreed
-
-with Mr. Morris immediately; that he is to take possession
-
-before Michaelmas, and some of his servants are to be in the
-
-house by the end of next week."
-
-
-"What is his name?"
-
-
-"Bingley."
-
-
-"Is he married or single?"
-
-
-"Oh!  Single, my dear, to be sure!  A single man of large
-
-fortune; four or five thousand a year.  What a fine thing for our
-
-girls!"
-
-
-"How so?  How can it affect them?"
-
-
-"My dear Mr. Bennet," replied his wife, "how can you be so
-
-tiresome!  You must know that I am thinking of his marrying
-
-one of them."
-
-
-"Is that his design in settling here?"
-
-
-"Design!  Nonsense, how can you talk so!  But it is very likely
-
-that he MAY fall in love with one of them, and therefore you
-
-must visit him as soon as he comes."
-
-
-"I see no occasion for that.  You and the girls may go, or you
-
-may send them by themselves, which perhaps will be still
-
-better, for as you are as handsome as any of them, Mr. Bingley
-
-may like you the best of the party."
-
-
-"My dear, you flatter me.  I certainly HAVE had my share of
-
-beauty, but I do not pretend to be anything extraordinary now.
-
-When a woman has five grown-up daughters, she ought to give
-
-over thinking of her own beauty."
-
-
-"In such cases, a woman has not often much beauty to think of."
-
-
-"But, my dear, you must indeed go and see Mr. Bingley when
-
-he comes into the neighbourhood."
-
-
-"It is more than I engage for, I assure you."
-
-
-"But consider your daughters.  Only think what an establishment
-
-it would be for one of them.  Sir William and Lady Lucas are
-
-determined to go, merely on that account, for in general, you
-
-know, they visit no newcomers.  Indeed you must go, for it will
-
-be impossible for US to visit him if you do not."
-
-
-"You are over-scrupulous, surely.  I dare say Mr. Bingley will
-
-be very glad to see you; and I will send a few lines by you to
-
-assure him of my hearty consent to his marrying whichever he
-
-chooses of the girls; though I must throw in a good word for
-
-my little Lizzy."
-
-
-"I desire you will do no such thing.  Lizzy is not a bit better
-
-than the others; and I am sure she is not half so handsome as
-
-Jane, nor half so good-humoured as Lydia.  But you are always
-
-giving HER the preference."
-
-
-"They have none of them much to recommend them," replied he;
-
-"they are all silly and ignorant like other girls; but Lizzy
-
-has something more of quickness than her sisters."
-
-
-"Mr. Bennet, how CAN you abuse your own children in such a
-
-way?  You take delight in vexing me.  You have no compassion
-
-for my poor nerves."
-
-
-"You mistake me, my dear.  I have a high respect for your
-
-nerves.  They are my old friends.  I have heard you mention
-
-them with consideration these last twenty years at least."
-
-
-Mr. Bennet was so odd a mixture of quick parts, sarcastic humour,
-
-reserve, and caprice, that the experience of three-and-twenty
-
-years had been insufficient to make his wife understand his
-
-character.  HER mind was less difficult to develop.  She was a
-
-woman of mean understanding, little information, and uncertain
-
-temper.  When she was discontented, she fancied herself nervous.
-
-The business of her life was to get her daughters married; its
-
-solace was visiting and news.
-
-
-
-
-Chapter 2
-
-
-
-Mr. Bennet was among the earliest of those who waited on Mr.
-
-Bingley.  He had always intended to visit him, though to the last
-
-always assuring his wife that he should not go; and till the
-
-evening after the visit was paid she had no knowledge of it.
-
-It was then disclosed in the following manner.  Observing his
-
-second daughter employed in trimming a hat, he suddenly
-
-addressed her with:
-
-
-"I hope Mr. Bingley will like it, Lizzy."
-
-
-"We are not in a way to know WHAT Mr. Bingley likes," said
-
-her mother resentfully, "since we are not to visit."
-
-
-"But you forget, mamma," said Elizabeth, "that we shall meet
-
-him at the assemblies, and that Mrs. Long promised to introduce
-
-him."
-
-
-"I do not believe Mrs. Long will do any such thing.  She has two
-
-nieces of her own.  She is a selfish, hypocritical woman, and I
-
-have no opinion of her."
-
-
-"No more have I," said Mr. Bennet; "and I am glad to find that
-
-you do not depend on her serving you."
-
-
-Mrs. Bennet deigned not to make any reply, but, unable to
-
-contain herself, began scolding one of her daughters.
-
-
-"Don't keep coughing so, Kitty, for Heaven's sake!  Have a little
-
-compassion on my nerves.  You tear them to pieces."
-
-
-"Kitty has no discretion in her coughs," said her father; "she
-
-times them ill."
-
-
-"I do not cough for my own amusement," replied Kitty fretfully.
-
-"When is your next ball to be, Lizzy?"
-
-
-"To-morrow fortnight."
-
-
-"Aye, so it is," cried her mother, "and Mrs. Long does not come
-
-back till the day before; so it will be impossible for her to
-
-introduce him, for she will not know him herself."
-
-
-"Then, my dear, you may have the advantage of your friend, and
-
-introduce Mr. Bingley to HER."
-
-
-"Impossible, Mr. Bennet, impossible, when I am not acquainted
-
-with him myself; how can you be so teasing?"
-
-
-"I honour your circumspection.  A fortnight's acquaintance is
-
-certainly very little.  One cannot know what a man really is by
-
-the end of a fortnight.  But if WE do not venture somebody else
-
-will; and after all, Mrs. Long and her daughters must stand their
-
-chance; and, therefore, as she will think it an act of kindness,
-
-if you decline the office, I will take it on myself."
-
-
-The girls stared at their father.  Mrs. Bennet said only,
-
-"Nonsense, nonsense!"
-
-
-"What can be the meaning of that emphatic exclamation?" cried
-
-he.  "Do you consider the forms of introduction, and the stress
-
-that is laid on them, as nonsense?  I cannot quite agree with
-
-you THERE.  What say you, Mary?  For you are a young lady of
-
-deep reflection, I know, and read great books and make extracts."
-
-
-Mary wished to say something sensible, but knew not how.
-
-
-"While Mary is adjusting her ideas," he continued, "let us return
-
-to Mr. Bingley."
-
-
-"I am sick of Mr. Bingley," cried his wife.
-
-
-"I am sorry to hear THAT; but why did not you tell me that
-
-before?  If I had known as much this morning I certainly would
-
-not have called on him.  It is very unlucky; but as I have
-
-actually paid the visit, we cannot escape the acquaintance now."
-
-
-The astonishment of the ladies was just what he wished; that of
-
-Mrs. Bennet perhaps surpassing the rest; though, when the first
-
-tumult of joy was over, she began to declare that it was what she
-
-had expected all the while.
-
-
-"How good it was in you, my dear Mr. Bennet!  But I knew I should
-
-persuade you at last.  I was sure you loved your girls too well
-
-to neglect such an acquaintance.  Well, how pleased I am! and it
-
-is such a good joke, too, that you should have gone this morning
-
-and never said a word about it till now."
-
-
-"Now, Kitty, you may cough as much as you choose," said Mr.
-
-Bennet; and, as he spoke, he left the room, fatigued with the
-
-raptures of his wife.
-
-
-"What an excellent father you have, girls!" said she, when the
-
-door was shut.  "I do not know how you will ever make him
-
-amends for his kindness; or me, either, for that matter.  At our
-
-time of life it is not so pleasant, I can tell you, to be making
-
-new acquaintances every day; but for your sakes, we would do
-
-anything.  Lydia, my love, though you ARE the youngest, I dare
-
-say Mr. Bingley will dance with you at the next ball."
-
-
-"Oh!" said Lydia stoutly, "I am not afraid; for though I AM the
-
-youngest, I'm the tallest."
-
-
-The rest of the evening was spent in conjecturing how soon he
-
-would return Mr. Bennet's visit, and determining when they
-
-should ask him to dinner.
-
-
-
-
-Chapter 3
-
-
-
-Not all that Mrs. Bennet, however, with the assistance of her
-
-five daughters, could ask on the subject, was sufficient to draw
-
-from her husband any satisfactory description of Mr. Bingley.
-
-They attacked him in various ways--with barefaced questions,
-
-ingenious suppositions, and distant surmises; but he eluded the
-
-skill of them all, and they were at last obliged to accept the
-
-second-hand intelligence of their neighbour, Lady Lucas.  Her
-
-report was highly favourable.  Sir William had been delighted
-
-with him.  He was quite young, wonderfully handsome, extremely
-
-agreeable, and, to crown the whole, he meant to be at the next
-
-assembly with a large party.  Nothing could be more delightful!
-
-To be fond of dancing was a certain step towards falling in love;
-
-and very lively hopes of Mr. Bingley's heart were entertained.
-
-
-"If I can but see one of my daughters happily settled at
-
-Netherfield," said Mrs. Bennet to her husband, "and all the
-
-others equally well married, I shall have nothing to wish for."
-
-
-In a few days Mr. Bingley returned Mr. Bennet's visit, and sat
-
-about ten minutes with him in his library.  He had entertained
-
-hopes of being admitted to a sight of the young ladies, of
-
-whose beauty he had heard much; but he saw only the father.
-
-The ladies were somewhat more fortunate, for they had the
-
-advantage of ascertaining from an upper window that he wore
-
-a blue coat, and rode a black horse.
-
-
-An invitation to dinner was soon afterwards dispatched; and
-
-already had Mrs. Bennet planned the courses that were to do
-
-credit to her housekeeping, when an answer arrived which
-
-deferred it all.  Mr. Bingley was obliged to be in town the
-
-following day, and, consequently, unable to accept the honour
-
-of their invitation, etc.  Mrs. Bennet was quite disconcerted.
-
-She could not imagine what business he could have in town so
-
-soon after his arrival in Hertfordshire; and she began to fear
-
-that he might be always flying about from one place to another,
-
-and never settled at Netherfield as he ought to be.  Lady Lucas
-
-quieted her fears a little by starting the idea of his being gone
-
-to London only to get a large party for the ball; and a report
-
-soon followed that Mr. Bingley was to bring twelve ladies and
-
-seven gentlemen with him to the assembly.  The girls grieved
-
-over such a number of ladies, but were comforted the day
-
-before the ball by hearing, that instead of twelve he brought
-
-only six with him from London--his five sisters and a cousin.
-
-And when the party entered the assembly room it consisted of
-
-only five altogether--Mr. Bingley, his two sisters, the husband
-
-of the eldest, and another young man.
-
-
-Mr. Bingley was good-looking and gentlemanlike; he had a pleasant
-
-countenance, and easy, unaffected manners.  His sisters were fine
-
-women, with an air of decided fashion.  His brother-in-law, Mr.
-
-Hurst, merely looked the gentleman; but his friend Mr. Darcy soon
-
-drew the attention of the room by his fine, tall person, handsome
-
-features, noble mien, and the report which was in general
-
-circulation within five minutes after his entrance, of his having
-
-ten thousand a year.  The gentlemen pronounced him to be a fine
-
-figure of a man, the ladies declared he was much handsomer than
-
-Mr. Bingley, and he was looked at with great admiration for about
-
-half the evening, till his manners gave a disgust which turned
-
-the tide of his popularity; for he was discovered to be proud;
-
-to be above his company, and above being pleased; and not all his
-
-large estate in Derbyshire could then save him from having a most
-
-forbidding, disagreeable countenance, and being unworthy to be
-
-compared with his friend.
-
-
-Mr. Bingley had soon made himself acquainted with all the
-
-principal people in the room; he was lively and unreserved,
-
-danced every dance, was angry that the ball closed so early,
-
-and talked of giving one himself at Netherfield.  Such amiable
-
-qualities must speak for themselves.  What a contrast between
-
-him and his friend!  Mr. Darcy danced only once with Mrs. Hurst
-
-and once with Miss Bingley, declined being introduced to any
-
-other lady, and spent the rest of the evening in walking about
-
-the room, speaking occasionally to one of his own party.  His
-
-character was decided.  He was the proudest, most disagreeable
-
-man in the world, and everybody hoped that he would never come
-
-there again.  Amongst the most violent against him was Mrs.
-
-Bennet, whose dislike of his general behaviour was sharpened
-
-into particular resentment by his having slighted one of her
-
-daughters.
-
-
-Elizabeth Bennet had been obliged, by the scarcity of gentlemen,
-
-to sit down for two dances; and during part of that time,
-
-Mr. Darcy had been standing near enough for her to hear a
-
-conversation between him and Mr. Bingley, who came from the
-
-dance for a few minutes, to press his friend to join it.
-
-
-"Come, Darcy," said he, "I must have you dance.  I hate to see
-
-you standing about by yourself in this stupid manner.  You had
-
-much better dance."
-
-
-"I certainly shall not.  You know how I detest it, unless I am
-
-particularly acquainted with my partner.  At such an assembly as
-
-this it would be insupportable.  Your sisters are engaged, and
-
-there is not another woman in the room whom it would not be a
-
-punishment to me to stand up with."
-
-
-"I would not be so fastidious as you are," cried Mr. Bingley,
-
-"for a kingdom!  Upon my honour, I never met with so many
-
-pleasant girls in my life as I have this evening; and there are
-
-several of them you see uncommonly pretty."
-
-
-"YOU are dancing with the only handsome girl in the room,"
-
-said Mr. Darcy, looking at the eldest Miss Bennet.
-
-
-"Oh! She is the most beautiful creature I ever beheld!  But
-
-there is one of her sisters sitting down just behind you, who is
-
-very pretty, and I dare say very agreeable.  Do let me ask my
-
-partner to introduce you."
-
-
-"Which do you mean?" and turning round he looked for a
-
-moment at Elizabeth, till catching her eye, he withdrew his own
-
-and coldly said: "She is tolerable, but not handsome enough to
-
-tempt ME; I am in no humour at present to give consequence
-
-to young ladies who are slighted by other men.  You had better
-
-return to your partner and enjoy her smiles, for you are wasting
-
-your time with me."
-
-
-Mr. Bingley followed his advice.  Mr. Darcy walked off; and
-
-Elizabeth remained with no very cordial feelings toward him.
-
-She told the story, however, with great spirit among her friends;
-
-for she had a lively, playful disposition, which delighted in
-
-anything ridiculous.
-
-
-The evening altogether passed off pleasantly to the whole
-
-family.  Mrs. Bennet had seen her eldest daughter much
-
-admired by the Netherfield party.  Mr. Bingley had danced with
-
-her twice, and she had been distinguished by his sisters.  Jane
-
-was as much gratified by this as her mother could be, though in
-
-a quieter way.  Elizabeth felt Jane's pleasure.  Mary had heard
-
-herself mentioned to Miss Bingley as the most accomplished
-
-girl in the neighbourhood; and Catherine and Lydia had been
-
-fortunate enough never to be without partners, which was all
-
-that they had yet learnt to care for at a ball.  They returned,
-
-therefore, in good spirits to Longbourn, the village where they
-
-lived, and of which they were the principal inhabitants.  They
-
-found Mr. Bennet still up.  With a book he was regardless of
-
-time; and on the present occasion he had a good deal of
-
-curiosity as to the events of an evening which had raised such
-
-splendid expectations.  He had rather hoped that his wife's
-
-views on the stranger would be disappointed; but he soon
-
-found out that he had a different story to hear.
-
-
-"Oh! my dear Mr. Bennet," as she entered the room, "we have
-
-had a most delightful evening, a most excellent ball.  I wish you
-
-had been there.  Jane was so admired, nothing could be like it.
-
-Everybody said how well she looked; and Mr. Bingley thought
-
-her quite beautiful, and danced with her twice!  Only think of
-
-THAT, my dear; he actually danced with her twice! and she was
-
-the only creature in the room that he asked a second time.
-
-First of all, he asked Miss Lucas.  I was so vexed to see him
-
-stand up with her!  But, however, he did not admire her at all;
-
-indeed, nobody can, you know; and he seemed quite struck with
-
-Jane as she was going down the dance.  So he inquired who she
-
-was, and got introduced, and asked her for the two next.  Then
-
-the two third he danced with Miss King, and the two fourth with
-
-Maria Lucas, and the two fifth with Jane again, and the two
-
-sixth with Lizzy, and the BOULANGER--"
-
-
-"If he had had any compassion for ME," cried her husband
-
-impatiently, "he would not have danced half so much!  For God's
-
-sake, say no more of his partners.  O that he had sprained
-
-his ankle in the first place!"
-
-
-"Oh! my dear, I am quite delighted with him.  He is so
-
-excessively handsome!  And his sisters are charming women.
-
-I never in my life saw anything more elegant than their dresses.
-
-I dare say the lace upon Mrs. Hurst's gown--"
-
-
-Here she was interrupted again.  Mr. Bennet protested against
-
-any description of finery.  She was therefore obliged to seek
-
-another branch of the subject, and related, with much bitterness
-
-of spirit and some exaggeration, the shocking rudeness of Mr.
-
-Darcy.
-
-
-"But I can assure you," she added, "that Lizzy does not lose
-
-much by not suiting HIS fancy; for he is a most disagreeable,
-
-horrid man, not at all worth pleasing.  So high and so conceited
-
-that there was no enduring him!  He walked here, and he walked
-
-there, fancying himself so very great!  Not handsome enough to
-
-dance with!  I wish you had been there, my dear, to have given
-
-him one of your set-downs.  I quite detest the man."
-
-
-
-
-Chapter 4
-
-
-
-When Jane and Elizabeth were alone, the former, who had been
-
-cautious in her praise of Mr. Bingley before, expressed to her
-
-sister just how very much she admired him.
-
-
-"He is just what a young man ought to be," said she, "sensible,
-
-good-humoured, lively; and I never saw such happy manners!--so
-
-much ease, with such perfect good breeding!"
-
-
-"He is also handsome," replied Elizabeth, "which a young man
-
-ought likewise to be, if he possibly can.  His character is thereby
-
-complete."
-
-
-"I was very much flattered by his asking me to dance a second
-
-time.  I did not expect such a compliment."
-
-
-"Did not you? I did for you.  But that is one great difference
-
-between us.  Compliments always take YOU by surprise, and
-
-ME never.  What could be more natural than his asking you
-
-again?  He could not help seeing that you were about five times
-
-as pretty as every other woman in the room.  No thanks to his
-
-gallantry for that.  Well, he certainly is very agreeable, and I
-
-give you leave to like him.  You have liked many a stupider
-
-person."
-
-
-"Dear Lizzy!"
-
-
-"Oh! you are a great deal too apt, you know, to like people in
-
-general.  You never see a fault in anybody.  All the world are
-
-good and agreeable in your eyes.  I never heard you speak ill of
-
-a human being in your life."
-
-
-"I would not wish to be hasty in censuring anyone; but I always
-
-speak what I think."
-
-
-"I know you do; and it is THAT which makes the wonder.  With YOUR
-
-good sense, to be so honestly blind to the follies and nonsense
-
-of others!  Affectation of candour is common enough--one meets
-
-with it everywhere.  But to be candid without ostentation or
-
-design--to take the good of everybody's character and make it
-
-still better, and say nothing of the bad--belongs to you alone.
-
-And so you like this man's sisters, too, do you?  Their manners
-
-are not equal to his."
-
-
-"Certainly not--at first.  But they are very pleasing women when
-
-you converse with them.  Miss Bingley is to live with her
-
-brother, and keep his house; and I am much mistaken if we shall
-
-not find a very charming neighbour in her."
-
-
-Elizabeth listened in silence, but was not convinced; their
-
-behaviour at the assembly had not been calculated to please in
-
-general; and with more quickness of observation and less pliancy
-
-of temper than her sister, and with a judgement too unassailed by
-
-any attention to herself, she was very little disposed to approve
-
-them.  They were in fact very fine ladies; not deficient in good
-
-humour when they were pleased, nor in the power of making
-
-themselves agreeable when they chose it, but proud and
-
-conceited.  They were rather handsome, had been educated in
-
-one of the first private seminaries in town, had a fortune of
-
-twenty thousand pounds, were in the habit of spending more
-
-than they ought, and of associating with people of rank, and
-
-were therefore in every respect entitled to think well of
-
-themselves, and meanly of others.  They were of a respectable
-
-family in the north of England; a circumstance more deeply
-
-impressed on their memories than that their brother's fortune
-
-and their own had been acquired by trade.
-
-
-Mr. Bingley inherited property to the amount of nearly a
-
-hundred thousand pounds from his father, who had intended to
-
-purchase an estate, but did not live to do it.  Mr. Bingley
-
-intended it likewise, and sometimes made choice of his county;
-
-but as he was now provided with a good house and the liberty of
-
-a manor, it was doubtful to many of those who best knew the
-
-easiness of his temper, whether he might not spend the
-
-remainder of his days at Netherfield, and leave the next
-
-generation to purchase.
-
-
-His sisters were anxious for his having an estate of his own; but,
-
-though he was now only established as a tenant, Miss Bingley
-
-was by no means unwilling to preside at his table--nor was Mrs.
-
-Hurst, who had married a man of more fashion than fortune, less
-
-disposed to consider his house as her home when it suited her.
-
-Mr. Bingley had not been of age two years, when he was tempted
-
-by an accidental recommendation to look at Netherfield House.
-
-He did look at it, and into it for half-an-hour--was pleased with
-
-the situation and the principal rooms, satisfied with what the
-
-owner said in its praise, and took it immediately.
-
-
-Between him and Darcy there was a very steady friendship, in
-
-spite of great opposition of character.  Bingley was endeared to
-
-Darcy by the easiness, openness, and ductility of his temper,
-
-though no disposition could offer a greater contrast to his own,
-
-and though with his own he never appeared dissatisfied.  On the
-
-strength of Darcy's regard, Bingley had the firmest reliance, and
-
-of his judgement the highest opinion.  In understanding, Darcy
-
-was the superior.  Bingley was by no means deficient, but Darcy
-
-was clever.  He was at the same time haughty, reserved, and
-
-fastidious, and his manners, though well-bred, were not inviting.
-
-In that respect his friend had greatly the advantage.  Bingley was
-
-sure of being liked wherever he appeared, Darcy was continually
-
-giving offense.
-
-
-The manner in which they spoke of the Meryton assembly was
-
-sufficiently characteristic.  Bingley had never met with more
-
-pleasant people or prettier girls in his life; everybody had been
-
-most kind and attentive to him; there had been no formality, no
-
-stiffness; he had soon felt acquainted with all the room; and, as
-
-to Miss Bennet, he could not conceive an angel more beautiful.
-
-Darcy, on the contrary, had seen a collection of people in whom
-
-there was little beauty and no fashion, for none of whom he had
-
-felt the smallest interest, and from none received either attention
-
-or pleasure.  Miss Bennet he acknowledged to be pretty, but she
-
-smiled too much.
-
-
-Mrs. Hurst and her sister allowed it to be so--but still they
-
-admired her and liked her, and pronounced her to be a sweet
-
-girl, and one whom they would not object to know more of.
-
-Miss Bennet was therefore established as a sweet girl, and their
-
-brother felt authorized by such commendation to think of her as
-
-he chose.
-
-
-
-
-Chapter 5
-
-
-
-Within a short walk of Longbourn lived a family with whom
-
-the Bennets were particularly intimate.  Sir William Lucas
-
-had been formerly in trade in Meryton, where he had made a
-
-tolerable fortune, and risen to the honour of knighthood by an
-
-address to the king during his mayoralty.  The distinction had
-
-perhaps been felt too strongly.  It had given him a disgust
-
-to his business, and to his residence in a small market town;
-
-and, in quitting them both, he had removed with his family
-
-to a house about a mile from Meryton, denominated from that
-
-period Lucas Lodge, where he could think with pleasure of his
-
-own importance, and, unshackled by business, occupy himself
-
-solely in being civil to all the world.  For, though elated by his
-
-rank, it did not render him supercilious; on the contrary, he was
-
-all attention to everybody.  By nature inoffensive, friendly, and
-
-obliging, his presentation at St. James's had made him courteous.
-
-
-Lady Lucas was a very good kind of woman, not too clever to
-
-be a valuable neighbour to Mrs. Bennet.  They had several
-
-children.  The eldest of them, a sensible, intelligent young
-
-woman, about twenty-seven, was Elizabeth's intimate friend.
-
-
-That the Miss Lucases and the Miss Bennets should meet to
-
-talk over a ball was absolutely necessary; and the morning after
-
-the assembly brought the former to Longbourn to hear and to
-
-communicate.
-
-
-"YOU began the evening well, Charlotte," said Mrs. Bennet with
-
-civil self-command to Miss Lucas.  "YOU were Mr. Bingley's
-
-first choice."
-
-
-"Yes; but he seemed to like his second better."
-
-
-"Oh! you mean Jane, I suppose, because he danced with her
-
-twice.  To be sure that DID seem as if he admired her--indeed
-
-I rather believe he DID--I heard something about it--but I
-
-hardly know what--something about Mr. Robinson."
-
-
-"Perhaps you mean what I overheard between him and Mr. Robinson;
-
-did not I mention it to you?  Mr. Robinson's asking him how he
-
-liked our Meryton assemblies, and whether he did not think there
-
-were a great many pretty women in the room, and WHICH he thought
-
-the prettiest? and his answering immediately to the last
-
-question: 'Oh! the eldest Miss Bennet, beyond a doubt; there
-
-cannot be two opinions on that point.'"
-
-
-"Upon my word!  Well, that is very decided indeed--that does
-
-seem as if--but, however, it may all come to nothing, you know."
-
-
-"MY overhearings were more to the purpose than YOURS, Eliza,"
-
-said Charlotte.  "Mr. Darcy is not so well worth listening to
-
-as his friend, is he?--poor Eliza!--to be only just TOLERABLE."
-
-
-"I beg you would not put it into Lizzy's head to be vexed by
-
-his ill-treatment, for he is such a disagreeable man, that it
-
-would be quite a misfortune to be liked by him.  Mrs. Long
-
-told me last night that he sat close to her for half-an-hour
-
-without once opening his lips."
-
-
-"Are you quite sure, ma'am?--is not there a little mistake?"
-
-said Jane.  "I certainly saw Mr. Darcy speaking to her."
-
-
-"Aye--because she asked him at last how he liked Netherfield,
-
-and he could not help answering her; but she said he seemed
-
-quite angry at being spoke to."
-
-
-"Miss Bingley told me," said Jane, "that he never speaks much,
-
-unless among his intimate acquaintances.  With THEM he is
-
-remarkably agreeable."
-
-
-"I do not believe a word of it, my dear.  If he had been so very
-
-agreeable, he would have talked to Mrs. Long.  But I can guess
-
-how it was; everybody says that he is eat up with pride, and I
-
-dare say he had heard somehow that Mrs. Long does not keep
-
-a carriage, and had come to the ball in a hack chaise."
-
-
-"I do not mind his not talking to Mrs. Long," said Miss Lucas,
-
-"but I wish he had danced with Eliza."
-
-
-"Another time, Lizzy," said her mother, "I would not dance
-
-with HIM, if I were you."
-
-
-"I believe, ma'am, I may safely promise you NEVER to dance
-
-with him."
-
-
-"His pride," said Miss Lucas, "does not offend ME so much as
-
-pride often does, because there is an excuse for it.  One cannot
-
-wonder that so very fine a young man, with family, fortune,
-
-everything in his favour, should think highly of himself.  If I
-
-may so express it, he has a RIGHT to be proud."
-
-
-"That is very true," replied Elizabeth, "and I could easily
-
-forgive HIS pride, if he had not mortified MINE."
-
-
-"Pride," observed Mary, who piqued herself upon the solidity
-
-of her reflections, "is a very common failing, I believe.  By
-
-all that I have ever read, I am convinced that it is very common
-
-indeed; that human nature is particularly prone to it, and
-
-that there are very few of us who do not cherish a feeling of
-
-self-complacency on the score of some quality or other, real
-
-or imaginary.  Vanity and pride are different things, though
-
-the words are often used synonymously.  A person may be proud
-
-without being vain.  Pride relates more to our opinion of
-
-ourselves, vanity to what we would have others think of us."
-
-
-"If I were as rich as Mr. Darcy," cried a young Lucas, who
-
-came with his sisters, "I should not care how proud I was.  I
-
-would keep a pack of foxhounds, and drink a bottle of wine a
-
-day."
-
-
-"Then you would drink a great deal more than you ought," said
-
-Mrs. Bennet; "and if I were to see you at it, I should take away
-
-your bottle directly."
-
-
-The boy protested that she should not; she continued to declare
-
-that she would, and the argument ended only with the visit.
-
-
-
-
-Chapter 6
-
-
-
-The ladies of Longbourn soon waited on those of Netherfield.
-
-The visit was soon returned in due form.  Miss Bennet's
-
-pleasing manners grew on the goodwill of Mrs. Hurst and Miss
-
-Bingley; and though the mother was found to be intolerable,
-
-and the younger sisters not worth speaking to, a wish of
-
-being better acquainted with THEM was expressed towards
-
-the two eldest.  By Jane, this attention was received with the
-
-greatest pleasure, but Elizabeth still saw superciliousness in
-
-their treatment of everybody, hardly excepting even her sister,
-
-and could not like them; though their kindness to Jane, such as it
-
-was, had a value as arising in all probability from the influence
-
-of their brother's admiration.  It was generally evident
-
-whenever they met, that he DID admire her and to HER it was
-
-equally evident that Jane was yielding to the preference which
-
-she had begun to entertain for him from the first, and was in a
-
-way to be very much in love; but she considered with pleasure
-
-that it was not likely to be discovered by the world in general,
-
-since Jane united, with great strength of feeling, a composure
-
-of temper and a uniform cheerfulness of manner which would
-
-guard her from the suspicions of the impertinent.  She
-
-mentioned this to her friend Miss Lucas.
-
-
-"It may perhaps be pleasant," replied Charlotte, "to be able to
-
-impose on the public in such a case; but it is sometimes a
-
-disadvantage to be so very guarded.  If a woman conceals her
-
-affection with the same skill from the object of it, she may lose
-
-the opportunity of fixing him; and it will then be but poor
-
-consolation to believe the world equally in the dark.  There is
-
-so much of gratitude or vanity in almost every attachment, that
-
-it is not safe to leave any to itself.  We can all BEGIN freely--a
-
-slight preference is natural enough; but there are very few of us
-
-who have heart enough to be really in love without encouragement.
-
-In nine cases out of ten a women had better show MORE affection
-
-than she feels.  Bingley likes your sister undoubtedly; but he
-
-may never do more than like her, if she does not help him on."
-
-
-"But she does help him on, as much as her nature will allow.
-
-If I can perceive her regard for him, he must be a simpleton,
-
-indeed, not to discover it too."
-
-
-"Remember, Eliza, that he does not know Jane's disposition as
-
-you do."
-
-
-"But if a woman is partial to a man, and does not endeavour to
-
-conceal it, he must find it out."
-
-
-"Perhaps he must, if he sees enough of her.  But, though
-
-Bingley and Jane meet tolerably often, it is never for many
-
-hours together; and, as they always see each other in large
-
-mixed parties, it is impossible that every moment should be
-
-employed in conversing together.  Jane should therefore make
-
-the most of every half-hour in which she can command his
-
-attention.  When she is secure of him, there will be more leisure
-
-for falling in love as much as she chooses."
-
-
-"Your plan is a good one," replied Elizabeth, "where nothing is
-
-in question but the desire of being well married, and if I were
-
-determined to get a rich husband, or any husband, I dare say I
-
-should adopt it.  But these are not Jane's feelings; she is not
-
-acting by design.  As yet, she cannot even be certain of the
-
-degree of her own regard nor of its reasonableness.  She has
-
-known him only a fortnight.  She danced four dances with him
-
-at Meryton; she saw him one morning at his own house, and
-
-has since dined with him in company four times.  This is not
-
-quite enough to make her understand his character."
-
-
-"Not as you represent it.  Had she merely DINED with him, she
-
-might only have discovered whether he had a good appetite; but
-
-you must remember that four evenings have also been spent
-
-together--and four evenings may do a great deal."
-
-
-"Yes; these four evenings have enabled them to ascertain that
-
-they both like Vingt-un better than Commerce; but with respect
-
-to any other leading characteristic, I do not imagine that much
-
-has been unfolded."
-
-
-"Well," said Charlotte, "I wish Jane success with all my heart;
-
-and if she were married to him to-morrow, I should think she
-
-had as good a chance of happiness as if she were to be studying
-
-his character for a twelvemonth.  Happiness in marriage is
-
-entirely  a matter of chance.  If the dispositions of the parties
-
-are ever so well known to each other or ever so similar beforehand,
-
-it does not advance their felicity in the least.  They always
-
-continue to grow sufficiently unlike afterwards to have their
-
-share of vexation; and it is better to know as little as possible
-
-of the defects of the person with whom you are to pass your life."
-
-
-"You make me laugh, Charlotte; but it is not sound.  You know
-
-it is not sound, and that you would never act in this way
-
-yourself."
-
-
-Occupied in observing Mr. Bingley's attentions to her sister,
-
-Elizabeth was far from suspecting that she was herself becoming
-
-an object of some interest in the eyes of his friend.  Mr. Darcy
-
-had at first scarcely allowed her to be pretty; he had looked at
-
-her without admiration at the ball; and when they next met, he
-
-looked at her only to criticise.  But no sooner had he made it
-
-clear to himself and his friends that she hardly had a good feature
-
-in her face, than he began to find it was rendered uncommonly
-
-intelligent by the beautiful expression of her dark eyes.  To this
-
-discovery succeeded some others equally mortifying.  Though he
-
-had detected with a critical eye more than one failure of perfect
-
-symmetry in her form, he was forced to acknowledge her figure
-
-to be light and pleasing; and in spite of his asserting that her
-
-manners were not those of the fashionable world, he was caught
-
-by their easy playfulness.  Of this she was perfectly unaware;
-
-to her he was only the man who made himself agreeable nowhere,
-
-and who had not thought her handsome enough to dance with.
-
-
-He began to wish to know more of her, and as a step towards
-
-conversing with her himself, attended to her conversation with
-
-others.  His doing so drew her notice.  It was at Sir William
-
-Lucas's, where a large party were assembled.
-
-
-"What does Mr. Darcy mean," said she to Charlotte, "by
-
-listening to my conversation with Colonel Forster?"
-
-
-"That is a question which Mr. Darcy only can answer."
-
-
-"But if he does it any more I shall certainly let him know that I
-
-see what he is about.  He has a very satirical eye, and if I do not
-
-begin by being impertinent myself, I shall soon grow afraid of
-
-him."
-
-
-On his approaching them soon afterwards, though without
-
-seeming to have any intention of speaking, Miss Lucas defied
-
-her friend to mention such a subject to him; which immediately
-
-provoking Elizabeth to do it, she turned to him and said:
-
-
-"Did you not think, Mr. Darcy, that I expressed myself
-
-uncommonly well just now, when I was teasing Colonel Forster
-
-to give us a ball at Meryton?"
-
-
-"With great energy; but it is always a subject which makes a lady
-
-energetic."
-
-
-"You are severe on us."
-
-
-"It will be HER turn soon to be teased," said Miss Lucas.  "I
-
-am going to open the instrument, Eliza, and you know what
-
-follows."
-
-
-"You are a very strange creature by way of a friend!--always
-
-wanting me to play and sing before anybody and everybody!
-
-If my vanity had taken a musical turn, you would have been
-
-invaluable; but as it is, I would really rather not sit down
-
-before those who must be in the habit of hearing the very best
-
-performers."  On Miss Lucas's persevering, however, she added,
-
-"Very well, if it must be so, it must."  And gravely glancing at
-
-Mr. Darcy, "There is a fine old saying, which everybody here is of
-
-course familiar with: 'Keep your breath to cool your porridge';
-
-and I shall keep mine to swell my song."
-
-
-Her performance was pleasing, though by no means capital.
-
-After a song or two, and before she could reply to the entreaties
-
-of several that she would sing again, she was eagerly succeeded
-
-at the instrument by her sister Mary, who having, in consequence
-
-of being the only plain one in the family, worked hard for
-
-knowledge and accomplishments, was always impatient for
-
-display.
-
-
-Mary had neither genius nor taste; and though vanity had given
-
-her application, it had given her likewise a pedantic air and
-
-conceited manner, which would have injured a higher degree of
-
-excellence than she had reached.  Elizabeth, easy and unaffected,
-
-had been listened to with much more pleasure, though not
-
-playing half so well; and Mary, at the end of a long concerto,
-
-was glad to purchase praise and gratitude by Scotch and Irish
-
-airs, at the request of her younger sisters, who, with some of the
-
-Lucases, and two or three officers, joined eagerly in dancing at
-
-one end of the room.
-
-
-Mr. Darcy stood near them in silent indignation at such a mode
-
-of passing the evening, to the exclusion of all conversation, and
-
-was too much engrossed by his thoughts to perceive that Sir
-
-William Lucas was his neighbour, till Sir William thus began:
-
-
-"What a charming amusement for young people this is, Mr. Darcy!
-
-There is nothing like dancing after all.  I consider it as one
-
-of the first refinements of polished society."
-
-
-"Certainly, sir; and it has the advantage also of being in vogue
-
-amongst the less polished societies of the world.  Every savage
-
-can dance."
-
-
-Sir William only smiled.  "Your friend performs delightfully," he
-
-continued after a pause, on seeing Bingley join the group; "and I
-
-doubt not that you are an adept in the science yourself, Mr.
-
-Darcy."
-
-
-"You saw me dance at Meryton, I believe, sir."
-
-
-"Yes, indeed, and received no inconsiderable pleasure from the
-
-sight.  Do you often dance at St. James's?"
-
-
-"Never, sir."
-
-
-"Do you not think it would be a proper compliment to the
-
-place?"
-
-
-"It is a compliment which I never pay to any place if I can
-
-avoid it."
-
-
-"You have a house in town, I conclude?"
-
-
-Mr. Darcy bowed.
-
-
-"I had once had some thought of fixing in town myself--for I am
-
-fond of superior society; but I did not feel quite certain that the
-
-air of London would agree with Lady Lucas."
-
-
-He paused in hopes of an answer; but his companion was not
-
-disposed to make any; and Elizabeth at that instant moving
-
-towards them, he was struck with the action of doing a very
-
-gallant thing, and called out to her:
-
-
-"My dear Miss Eliza, why are you not dancing?  Mr. Darcy, you
-
-must allow me to present this young lady to you as a very
-
-desirable partner.  You cannot refuse to dance, I am sure when
-
-so much beauty is before you."  And, taking her hand, he would
-
-have given it to Mr. Darcy who, though extremely surprised,
-
-was not unwilling to receive it, when she instantly drew back,
-
-and said with some discomposure to Sir William:
-
-
-"Indeed, sir, I have not the least intention of dancing.  I entreat
-
-you not to suppose that I moved this way in order to beg for a
-
-partner."
-
-
-Mr. Darcy, with grave propriety, requested to be allowed the
-
-honour of her hand, but in vain.  Elizabeth was determined; nor
-
-did Sir William at all shake her purpose by his attempt at
-
-persuasion.
-
-
-"You excel so much in the dance, Miss Eliza, that it is cruel to
-
-deny me the happiness of seeing you; and though this gentleman
-
-dislikes the amusement in general, he can have no objection, I
-
-am sure, to oblige us for one half-hour."
-
-
-"Mr. Darcy is all politeness," said Elizabeth, smiling.
-
-
-"He is, indeed; but, considering the inducement, my dear Miss
-
-Eliza, we cannot wonder at his complaisance--for who would
-
-object to such a partner?"
-
-
-Elizabeth looked archly, and turned away.  Her resistance had
-
-not injured her with the gentleman, and he was thinking of her
-
-with some complacency, when thus accosted by Miss Bingley:
-
-
-"I can guess the subject of your reverie."
-
-
-"I should imagine not."
-
-
-"You are considering how insupportable it would be to pass many
-
-evenings in this manner--in such society; and indeed I am quite
-
-of your opinion.  I was never more annoyed!  The insipidity, and
-
-yet the noise--the nothingness, and yet the self-importance of all
-
-those people!  What would I give to hear your strictures on them!"
-
-
-"You conjecture is totally wrong, I assure you.  My mind was
-
-more agreeably engaged.  I have been meditating on the very
-
-great pleasure which a pair of fine eyes in the face of a pretty
-
-woman can bestow."
-
-
-Miss Bingley immediately fixed her eyes on his face, and desired
-
-he would tell her what lady had the credit of inspiring such
-
-reflections.  Mr. Darcy replied with great intrepidity:
-
-
-"Miss Elizabeth Bennet."
-
-
-"Miss Elizabeth Bennet!" repeated Miss Bingley.  "I am all
-
-astonishment.  How long has she been such a favourite?--and
-
-pray, when am I to wish you joy?"
-
-
-"That is exactly the question which I expected you to ask.  A
-
-lady's imagination is very rapid; it jumps from admiration to
-
-love, from love to matrimony, in a moment.  I knew you would
-
-be wishing me joy."
-
-
-"Nay, if you are serious about it, I shall consider the matter is
-
-absolutely settled.  You will be having a charming mother-in-law,
-
-indeed; and, of course, she will always be at Pemberley with you."
-
-
-He listened to her with perfect indifference while she chose to
-
-entertain herself in this manner; and as his composure convinced
-
-her that all was safe, her wit flowed long.
-
-
-
-
-Chapter 7
-
-
-
-Mr. Bennet's property consisted almost entirely in an estate of
-
-two thousand a year, which, unfortunately for his daughters, was
-
-entailed, in default of heirs male, on a distant relation; and their
-
-mother's fortune, though ample for her situation in life, could
-
-but ill supply the deficiency of his.  Her father had been an
-
-attorney in Meryton, and had left her four thousand pounds.
-
-
-She had a sister married to a Mr. Phillips, who had been a clerk
-
-to their father and succeeded him in the business, and a brother
-
-settled in London in a respectable line of trade.
-
-
-The village of Longbourn was only one mile from Meryton; a
-
-most convenient distance for the young ladies, who were usually
-
-tempted thither three or four times a week, to pay their duty to
-
-their aunt and to a milliner's shop just over the way.  The two
-
-youngest of the family, Catherine and Lydia, were particularly
-
-frequent in these attentions; their minds were more vacant than
-
-their sisters', and when nothing better offered, a walk to
-
-Meryton was necessary to amuse their morning hours and
-
-furnish conversation for the evening; and however bare of news
-
-the country in general might be, they always contrived to learn
-
-some from their aunt.  At present, indeed, they were well
-
-supplied both with news and happiness by the recent arrival of
-
-a militia regiment in the neighbourhood; it was to remain the
-
-whole winter, and Meryton was the headquarters.
-
-
-Their visits to Mrs. Phillips were now productive of the most
-
-interesting intelligence.  Every day added something to their
-
-knowledge of the officers' names and connections.  Their
-
-lodgings were not long a secret, and at length they began to
-
-know the officers themselves.  Mr. Phillips visited them all, and
-
-this opened to his nieces a store of felicity unknown before.
-
-They could talk of nothing but officers; and Mr. Bingley's large
-
-fortune, the mention of which gave animation to their mother,
-
-was worthless in their eyes when opposed to the regimentals of
-
-an ensign.
-
-
-After listening one morning to their effusions on this subject, Mr.
-
-Bennet coolly observed:
-
-
-"From all that I can collect by your manner of talking, you must
-
-be two of the silliest girls in the country.  I have suspected it
-
-some time, but I am now convinced."
-
-
-Catherine was disconcerted, and made no answer; but Lydia,
-
-with perfect indifference, continued to express her admiration of
-
-Captain Carter, and her hope of seeing him in the course of the
-
-day, as he was going the next morning to London.
-
-
-"I am astonished, my dear," said Mrs. Bennet, "that you should
-
-be so ready to think your own children silly.  If I wished to think
-
-slightingly of anybody's children, it should not be of my own,
-
-however."
-
-
-"If my children are silly, I must hope to be always sensible of it."
-
-
-"Yes--but as it happens, they are all of them very clever."
-
-
-"This is the only point, I flatter myself, on which we do not
-
-agree.  I had hoped that our sentiments coincided in every
-
-particular, but I must so far differ from you as to think our two
-
-youngest daughters uncommonly foolish."
-
-
-"My dear Mr. Bennet, you must not expect such girls to have
-
-the sense of their father and mother.  When they get to our age, I
-
-dare say they will not think about officers any more than we do.
-
-I remember the time when I liked a red coat myself very well--and,
-
-indeed, so I do still at my heart; and if a smart young colonel,
-
-with five or six thousand a year, should want one of my girls I
-
-shall not say nay to him; and I thought Colonel Forster looked
-
-very becoming the other night at Sir William's in his regimentals."
-
-
-"Mamma," cried Lydia, "my aunt says that Colonel Forster and
-
-Captain Carter do not go so often to Miss Watson's as they did
-
-when they first came; she sees them now very often standing in
-
-Clarke's library."
-
-
-Mrs. Bennet was prevented replying by the entrance of the
-
-footman with a note for Miss Bennet; it came from Netherfield,
-
-and the servant waited for an answer.  Mrs. Bennet's eyes
-
-sparkled with pleasure, and she was eagerly calling out, while
-
-her daughter read,
-
-
-"Well, Jane, who is it from?  What is it about?  What does he
-
-say?  Well, Jane, make haste and tell us; make haste, my love."
-
-
-"It is from Miss Bingley," said Jane, and then read it aloud.
-
-
-"MY DEAR FRIEND,--
-
-
-"If you are not so compassionate as to dine to-day with Louisa
-
-and me, we shall be in danger of hating each other for the rest
-
-of our lives, for a whole day's tete-a-tete between two women
-
-can never end without a quarrel.  Come as soon as you can on
-
-receipt of this.  My brother and the gentlemen are to dine with
-
-the officers.--Yours ever,
-
-
-"CAROLINE BINGLEY"
-
-
-"With the officers!" cried Lydia.  "I wonder my aunt did not tell
-
-us of THAT."
-
-
-"Dining out," said Mrs. Bennet, "that is very unlucky."
-
-
-"Can I have the carriage?" said Jane.
-
-
-"No, my dear, you had better go on horseback, because it seems
-
-likely to rain; and then you must stay all night."
-
-
-"That would be a good scheme," said Elizabeth, "if you were
-
-sure that they would not offer to send her home."
-
-
-"Oh! but the gentlemen will have Mr. Bingley's chaise to go to
-
-Meryton, and the Hursts have no horses to theirs."
-
-
-"I had much rather go in the coach."
-
-
-"But, my dear, your father cannot spare the horses, I am sure.
-
-They are wanted in the farm, Mr. Bennet, are they not?"
-
-
-"They are wanted in the farm much oftener than I can get them."
-
-
-"But if you have got them to-day," said Elizabeth, "my mother's
-
-purpose will be answered."
-
-
-She did at last extort from her father an acknowledgment that
-
-the horses were engaged.  Jane was therefore obliged to go on
-
-horseback, and her mother attended her to the door with many
-
-cheerful prognostics of a bad day.  Her hopes were answered;
-
-Jane had not been gone long before it rained hard.  Her sisters
-
-were uneasy for her, but her mother was delighted.  The rain
-
-continued the whole evening without intermission; Jane certainly
-
-could not come back.
-
-
-"This was a lucky idea of mine, indeed!" said Mrs. Bennet more
-
-than once, as if the credit of making it rain were all her own.  Till
-
-the next morning, however, she was not aware of all the felicity
-
-of her contrivance.  Breakfast was scarcely over when a servant
-
-from Netherfield brought the following note for Elizabeth:
-
-
-"MY DEAREST LIZZY,--
-
-
-"I find myself very unwell this morning, which, I suppose, is to
-
-be imputed to my getting wet through yesterday.  My kind friends
-
-will not hear of my returning till I am better.  They insist also
-
-on my seeing Mr. Jones--therefore do not be alarmed if you should
-
-hear of his having been to me--and, excepting a sore throat and
-
-headache, there is not much the matter with me.--Yours, etc."
-
-
-"Well, my dear," said Mr. Bennet, when Elizabeth had read the
-
-note aloud, "if your daughter should have a dangerous fit of
-
-illness--if she should die, it would be a comfort to know that it
-
-was all in pursuit of Mr. Bingley, and under your orders."
-
-
-"Oh! I am not afraid of her dying.  People do not die of little
-
-trifling colds.  She will be taken good care of.  As long as she
-
-stays there, it is all very well.  I would go an see her if I could
-
-have the carriage."
-
-
-Elizabeth, feeling really anxious, was determined to go to her,
-
-though the carriage was not to be had; and as she was no
-
-horsewoman, walking was her only alternative.  She declared her
-
-resolution.
-
-
-"How can you be so silly," cried her mother, "as to think of such
-
-a thing, in all this dirt!  You will not be fit to be seen when you
-
-get there."
-
-
-"I shall be very fit to see Jane--which is all I want."
-
-
-"Is this a hint to me, Lizzy," said her father, "to send for
-
-the horses?"
-
-
-"No, indeed, I do not wish to avoid the walk.  The distance is
-
-nothing when one has a motive; only three miles.  I shall be back
-
-by dinner."
-
-
-"I admire the activity of your benevolence," observed Mary, "but
-
-every impulse of feeling should be guided by reason; and, in my
-
-opinion, exertion should always be in proportion to what is
-
-required."
-
-
-"We will go as far as Meryton with you," said Catherine and
-
-Lydia.  Elizabeth accepted their company, and the three young
-
-ladies set off together.
-
-
-"If we make haste," said Lydia, as they walked along, "perhaps
-
-we may see something of Captain Carter before he goes."
-
-
-In Meryton they parted; the two youngest repaired to the lodgings of
-
-one of the officers' wives, and Elizabeth continued her walk alone,
-
-crossing field after field at a quick pace, jumping over stiles
-
-and springing over puddles with impatient activity, and finding
-
-herself at last within view of the house, with weary ankles, dirty
-
-stockings, and a face glowing with the warmth of exercise.
-
-
-She was shown into the breakfast-parlour, where all but Jane
-
-were assembled, and where her appearance created a great deal
-
-of surprise.  That she should have walked three miles so early
-
-in the day, in such dirty weather, and by herself, was almost
-
-incredible to Mrs. Hurst and Miss Bingley; and Elizabeth was
-
-convinced that they held her in contempt for it.  She was
-
-received, however, very politely by them; and in their brother's
-
-manners there was something better than politeness; there was
-
-good humour and kindness.  Mr. Darcy said very little, and Mr.
-
-Hurst nothing at all.  The former was divided between admiration
-
-of the brilliancy which exercise had given to her complexion,
-
-and doubt as to the occasion's justifying her coming so far
-
-alone.  The latter was thinking only of his breakfast.
-
-
-Her inquiries after her sister were not very favourably answered.
-
-Miss Bennet had slept ill, and though up, was very feverish, and
-
-not well enough to leave her room.  Elizabeth was glad to be
-
-taken to her immediately; and Jane, who had only been withheld
-
-by the fear of giving alarm or inconvenience from expressing in
-
-her note how much she longed for such a visit, was delighted at
-
-her entrance.  She was not equal, however, to much conversation,
-
-and when Miss Bingley left them together, could attempt little
-
-besides expressions of gratitude for the extraordinary kindness
-
-she was treated with.  Elizabeth silently attended her.
-
-
-When breakfast was over they were joined by the sisters; and
-
-Elizabeth began to like them herself, when she saw how much
-
-affection and solicitude they showed for Jane.  The apothecary
-
-came, and having examined his patient, said, as might be
-
-supposed, that she had caught a violent cold, and that they must
-
-endeavour to get the better of it; advised her to return to bed,
-
-and promised her some draughts.  The advice was followed
-
-readily, for the feverish symptoms increased, and her head ached
-
-acutely.  Elizabeth did not quit her room for a moment; nor were
-
-the other ladies often absent; the gentlemen being out, they had,
-
-in fact, nothing to do elsewhere.
-
-
-When the clock struck three, Elizabeth felt that she must go, and
-
-very unwillingly said so.  Miss Bingley offered her the carriage,
-
-and she only wanted a little pressing to accept it, when Jane
-
-testified such concern in parting with her, that Miss Bingley was
-
-obliged to convert the offer of the chaise to an invitation to
-
-remain at Netherfield for the present.  Elizabeth most thankfully
-
-consented, and a servant was dispatched to Longbourn to
-
-acquaint the family with her stay and bring back a supply of
-
-clothes.
-
-
-
-
-Chapter 8
-
-
-
-At five o'clock the two ladies retired to dress, and at half-past
-
-six Elizabeth was summoned to dinner.  To the civil inquiries
-
-which then poured in, and amongst which she had the pleasure
-
-of distinguishing the much superior solicitude of Mr. Bingley's,
-
-she could not make a very favourable answer.  Jane was by no
-
-means better.  The sisters, on hearing this, repeated three or four
-
-times how much they were grieved, how shocking it was to have
-
-a bad cold, and how excessively they disliked being ill
-
-themselves; and then thought no more of the matter: and their
-
-indifference towards Jane when not immediately before them
-
-restored Elizabeth to the enjoyment of all her former dislike.
-
-
-Their brother, indeed, was the only one of the party whom she
-
-could regard with any complacency.  His anxiety for Jane was
-
-evident, and his attentions to herself most pleasing, and
-
-they prevented her feeling herself so much an intruder as she
-
-believed she was considered by the others.  She had very little
-
-notice from any but him.  Miss Bingley was engrossed by Mr.
-
-Darcy, her sister scarcely less so; and as for Mr. Hurst, by
-
-whom Elizabeth sat, he was an indolent man, who lived only to
-
-eat, drink, and play at cards; who, when he found her to prefer
-
-a plain dish to a ragout, had nothing to say to her.
-
-
-When dinner was over, she returned directly to Jane, and Miss
-
-Bingley began abusing her as soon as she was out of the room.
-
-Her manners were pronounced to be very bad indeed, a mixture
-
-of pride and impertinence; she had no conversation, no style, no
-
-beauty.  Mrs. Hurst thought the same, and added:
-
-
-"She has nothing, in short, to recommend her, but being an
-
-excellent walker.  I shall never forget her appearance this
-
-morning.  She really looked almost wild."
-
-
-"She did, indeed, Louisa.  I could hardly keep my countenance.
-
-Very nonsensical to come at all!  Why must SHE be scampering
-
-about the country, because her sister had a cold?  Her hair, so
-
-untidy, so blowsy!"
-
-
-"Yes, and her petticoat; I hope you saw her petticoat, six inches
-
-deep in mud, I am absolutely certain; and the gown which had
-
-been let down to hide it not doing its office."
-
-
-"Your picture may be very exact, Louisa," said Bingley; "but
-
-this was all lost upon me.  I thought Miss Elizabeth Bennet
-
-looked remarkably well when she came into the room this
-
-morning.  Her dirty petticoat quite escaped my notice."
-
-
-"YOU observed it, Mr. Darcy, I am sure," said Miss Bingley;
-
-"and I am inclined to think that you would not wish to see
-
-YOUR sister make such an exhibition."
-
-
-"Certainly not."
-
-
-"To walk three miles, or four miles, or five miles, or whatever it
-
-is, above her ankles in dirt, and alone, quite alone!  What could
-
-she mean by it?  It seems to me to show an abominable sort of
-
-conceited independence, a most country-town indifference to
-
-decorum."
-
-
-"It shows an affection for her sister that is very pleasing," said
-
-Bingley.
-
-
-"I am afraid, Mr. Darcy," observed Miss Bingley in a half
-
-whisper, "that this adventure has rather affected your
-
-admiration of her fine eyes."
-
-
-"Not at all," he replied; "they were brightened by the exercise."
-
-A short pause followed this speech, and Mrs. Hurst began again:
-
-
-"I have a excessive regard for Miss Jane Bennet, she is really
-
-a very sweet girl, and I wish with all my heart she were well
-
-settled.  But with such a father and mother, and such low
-
-connections, I am afraid there is no chance of it."
-
-
-"I think I have heard you say that their uncle is an attorney on
-
-Meryton."
-
-
-"Yes; and they have another, who lives somewhere near Cheapside."
-
-
-"That is capital," added her sister, and they both laughed heartily.
-
-
-"If they had uncles enough to fill ALL Cheapside," cried
-
-Bingley, "it would not make them one jot less agreeable."
-
-
-"But it must very materially lessen their chance of marrying men
-
-of any consideration in the world," replied Darcy.
-
-
-To this speech Bingley made no answer; but his sisters gave it
-
-their hearty assent, and indulged their mirth for some time at the
-
-expense of their dear friend's vulgar relations.
-
-
-With a renewal of tenderness, however, they returned to her
-
-room on leaving the dining-parlour, and sat with her till
-
-summoned to coffee.  She was still very poorly, and Elizabeth
-
-would not quit her at all, till late in the evening, when she had
-
-the comfort of seeing her sleep, and when it seemed to her rather
-
-right than pleasant that she should go downstairs herself.  On
-
-entering the drawing-room she found the whole party at loo, and
-
-was immediately invited to join them; but suspecting them to be
-
-playing high she declined it, and making her sister the excuse,
-
-said she would amuse herself for the short time she could stay
-
-below, with a book.  Mr. Hurst looked at her with astonishment.
-
-
-"Do you prefer reading to cards?" said he; "that is rather
-
-singular."
-
-
-"Miss Eliza Bennet," said Miss Bingley, "despises cards.  She is
-
-a great reader, and has no pleasure in anything else."
-
-
-"I deserve neither such praise nor such censure," cried Elizabeth;
-
-"I am NOT a great reader, and I have pleasure in many things."
-
-
-"In nursing your sister I am sure you have pleasure," said Bingley;
-
-"and I hope it will be soon increased by seeing her quite well."
-
-
-Elizabeth thanked him from her heart, and then walked towards
-
-the table where a few books were lying.  He immediately offered
-
-to fetch her others--all that his library afforded.
-
-
-"And I wish my collection were larger for your benefit and my
-
-own credit; but I am an idle fellow, and though I have not many,
-
-I have more than I ever looked into."
-
-
-Elizabeth assured him that she could suit herself perfectly with
-
-those in the room.
-
-
-"I am astonished," said Miss Bingley, "that my father should
-
-have left so small a collection of books.  What a delightful library
-
-you have at Pemberley, Mr. Darcy!"
-
-
-"It ought to be good," he replied, "it has been the work of many
-
-generations."
-
-
-"And then you have added so much to it yourself, you are
-
-always buying books."
-
-
-"I cannot comprehend the neglect of a family library in such days
-
-as these."
-
-
-"Neglect!  I am sure you neglect nothing that can add to the
-
-beauties of that noble place.  Charles, when you build YOUR
-
-house, I wish it may be half as delightful as Pemberley."
-
-
-"I wish it may."
-
-
-"But I would really advise you to make your purchase in that
-
-neighbourhood, and take Pemberley for a kind of model.  There
-
-is not a finer county in England than Derbyshire."
-
-
-"With all my heart; I will buy Pemberley itself if Darcy will
-
-sell it."
-
-
-"I am talking of possibilities, Charles."
-
-
-"Upon my word, Caroline, I should think it more possible to get
-
-Pemberley by purchase than by imitation."
-
-
-Elizabeth was so much caught with what passed, as to leave her
-
-very little attention for her book; and soon laying it wholly
-
-aside, she drew near the card-table, and stationed herself
-
-between Mr. Bingley and his eldest sister, to observe the game.
-
-
-"Is Miss Darcy much grown since the spring?" said Miss
-
-Bingley; "will she be as tall as I am?"
-
-
-"I think she will.  She is now about Miss Elizabeth Bennet's
-
-height, or rather taller."
-
-
-"How I long to see her again!  I never met with anybody who
-
-delighted me so much.  Such a countenance, such manners!  And
-
-so extremely accomplished for her age!  Her performance on the
-
-pianoforte is exquisite."
-
-
-"It is amazing to me," said Bingley, "how young ladies can have
-
-patience to be so very accomplished as they all are."
-
-
-"All young ladies accomplished!  My dear Charles, what do you mean?"
-
-
-"Yes, all of them, I think.  They all paint tables, cover screens,
-
-and net purses.  I scarcely know anyone who cannot do all this,
-
-and I am sure I never heard a young lady spoken of for the first
-
-time, without being informed that she was very accomplished."
-
-
-"Your list of the common extent of accomplishments," said Darcy,
-
-"has too much truth.  The word is applied to many a woman who
-
-deserves it no otherwise than by netting a purse or covering
-
-a screen.  But I am very far from agreeing with you in your
-
-estimation of ladies in general.  I cannot boast of knowing
-
-more than half-a-dozen, in the whole range of my acquaintance,
-
-that are really accomplished."
-
-
-"Nor I, I am sure," said Miss Bingley.
-
-
-"Then," observed Elizabeth, "you must comprehend a great deal
-
-in your idea of an accomplished woman."
-
-
-"Yes, I do comprehend a great deal in it."
-
-
-"Oh! certainly," cried his faithful assistant, "no one can be really
-
-esteemed accomplished who does not greatly surpass what is
-
-usually met with.  A woman must have a thorough knowledge of
-
-music, singing, drawing, dancing, and the modern languages, to
-
-deserve the word; and besides all this, she must possess a certain
-
-something in her air and manner of walking, the tone of her
-
-voice, her address and expressions, or the word will be but
-
-half-deserved."
-
-
-"All this she must possess," added Darcy, "and to all this she
-
-must yet add something more substantial, in the improvement of
-
-her mind by extensive reading."
-
-
-"I am no longer surprised at your knowing ONLY six accomplished
-
-women.  I rather wonder now at your knowing ANY."
-
-
-"Are you so severe upon your own sex as to doubt the possibility
-
-of all this?"
-
-
-"I never saw such a woman.  I never saw such capacity, and
-
-taste, and application, and elegance, as you describe united."
-
-
-Mrs. Hurst and Miss Bingley both cried out against the injustice
-
-of her implied doubt, and were both protesting that they knew
-
-many women who answered this description, when Mr. Hurst
-
-called them to order, with bitter complaints of their inattention
-
-to what was going forward.  As all conversation was thereby at
-
-an end, Elizabeth soon afterwards left the room.
-
-
-"Elizabeth Bennet," said Miss Bingley, when the door was
-
-closed on her, "is one of those young ladies who seek to
-
-recommend themselves to the other sex by undervaluing their
-
-own; and with many men, I dare say, it succeeds.  But, in my
-
-opinion, it is a paltry device, a very mean art."
-
-
-"Undoubtedly," replied Darcy, to whom this remark was chiefly
-
-addressed, "there is a meanness in ALL the arts which ladies
-
-sometimes condescend to employ for captivation.  Whatever
-
-bears affinity to cunning is despicable."
-
-
-Miss Bingley was not so entirely satisfied with this reply as to
-
-continue the subject.
-
-
-Elizabeth joined them again only to say that her sister was worse,
-
-and that she could not leave her.  Bingley urged Mr. Jones being
-
-sent for immediately; while his sisters, convinced that no country
-
-advice could be of any service, recommended an express to town for
-
-one of the most eminent physicians.  This she would not hear of;
-
-but she was not so unwilling to comply with their brother's
-
-proposal; and it was settled that Mr. Jones should be sent for
-
-early in the morning, if Miss Bennet were not decidedly better.
-
-Bingley was quite uncomfortable; his sisters declared that they
-
-were miserable.  They solaced their wretchedness, however, by
-
-duets after supper, while he could find no better relief to his
-
-feelings than by giving his housekeeper directions that every
-
-attention might be paid to the sick lady and her sister.
-
-
-
-
-Chapter 9
-
-
-
-Elizabeth passed the chief of the night in her sister's room, and
-
-in the morning had the pleasure of being able to send a tolerable
-
-answer to the inquiries which she very early received from Mr.
-
-Bingley by a housemaid, and some time afterwards from the two
-
-elegant ladies who waited on his sisters.  In spite of this
-
-amendment, however, she requested to have a note sent to Longbourn,
-
-desiring her mother to visit Jane, and form her own judgement of
-
-her situation.  The note was immediately dispatched, and its
-
-contents as quickly complied with.  Mrs. Bennet, accompanied by
-
-her two youngest girls, reached Netherfield soon after the family
-
-breakfast.
-
-
-Had she found Jane in any apparent danger, Mrs. Bennet would
-
-have been very miserable; but being satisfied on seeing her that
-
-her illness was not alarming, she had no wish of her recovering
-
-immediately, as her restoration to health would probably remove
-
-her from Netherfield.  She would not listen, therefore, to her
-
-daughter's proposal of being carried home; neither did the
-
-apothecary, who arrived about the same time, think it at all
-
-advisable.  After sitting a little while with Jane, on Miss
-
-Bingley's appearance and invitation, the mother and three
-
-daughter all attended her into the breakfast parlour.  Bingley met
-
-them with hopes that Mrs. Bennet had not found Miss Bennet
-
-worse than she expected.
-
-
-"Indeed I have, sir," was her answer.  "She is a great deal too
-
-ill to be moved.  Mr. Jones says we must not think of moving her.
-
-We must trespass a little longer on your kindness."
-
-
-"Removed!" cried Bingley.  "It must not be thought of.  My
-
-sister, I am sure, will not hear of her removal."
-
-
-"You may depend upon it, Madam," said Miss Bingley, with cold
-
-civility, "that Miss Bennet will receive every possible attention
-
-while she remains with us."
-
-
-Mrs. Bennet was profuse in her acknowledgments.
-
-
-"I am sure," she added, "if it was not for such good friends I do
-
-not know what would become of her, for she is very ill indeed,
-
-and suffers a vast deal, though with the greatest patience in the
-
-world, which is always the way with her, for she has, without
-
-exception, the sweetest temper I have ever met with.  I often tell
-
-my other girls they are nothing to HER.  You have a sweet room
-
-here, Mr. Bingley, and a charming prospect over the gravel walk.
-
-I do not know a place in the country that is equal to Netherfield.
-
-You will not think of quitting it in a hurry, I hope, though you
-
-have but a short lease."
-
-
-"Whatever I do is done in a hurry," replied he; "and therefore if I
-
-should resolve to quit Netherfield, I should probably be off in
-
-five minutes.  At present, however, I consider myself as quite
-
-fixed here."
-
-
-"That is exactly what I should have supposed of you," said
-
-Elizabeth.
-
-
-"You begin to comprehend me, do you?" cried he, turning
-
-towards her.
-
-
-"Oh! yes--I understand you perfectly."
-
-
-"I wish I might take this for a compliment; but to be so easily
-
-seen through I am afraid is pitiful."
-
-
-"That is as it happens.  It does not follow that a deep, intricate
-
-character is more or less estimable than such a one as yours."
-
-
-"Lizzy," cried her mother, "remember where you are, and do not
-
-run on in the wild manner that you are suffered to do at home."
-
-
-"I did not know before," continued Bingley immediately, "that
-
-your were a studier of character.  It must be an amusing study."
-
-
-"Yes, but intricate characters are the MOST amusing.  They
-
-have at least that advantage."
-
-
-"The country," said Darcy, "can in general supply but a few
-
-subjects for such a study.  In a country neighbourhood you move
-
-in a very confined and unvarying society."
-
-
-"But people themselves alter so much, that there is something
-
-new to be observed in them for ever."
-
-
-"Yes, indeed," cried Mrs. Bennet, offended by his manner of
-
-mentioning a country neighbourhood.  "I assure you there is
-
-quite as much of THAT going on in the country as in town."
-
-
-Everybody was surprised, and Darcy, after looking at her for a
-
-moment, turned silently away.  Mrs. Bennet, who fancied she
-
-had gained a complete victory over him, continued her triumph.
-
-
-"I cannot see that London has any great advantage over the
-
-country, for my part, except the shops and public places.  The
-
-country is a vast deal pleasanter, is it not, Mr. Bingley?"
-
-
-"When I am in the country," he replied, "I never wish to leave it;
-
-and when I am in town it is pretty much the same.  They have
-
-each their advantages, and I can be equally happy in either."
-
-
-"Aye--that is because you have the right disposition.  But that
-
-gentleman," looking at Darcy, "seemed to think the country was
-
-nothing at all."
-
-
-"Indeed, Mamma, you are mistaken," said Elizabeth, blushing for
-
-her mother.  "You quite mistook Mr. Darcy.  He only meant that
-
-there was not such a variety of people to be met with in the
-
-country as in the town, which you must acknowledge to be
-
-true."
-
-
-"Certainly, my dear, nobody said there were; but as to not
-
-meeting with many people in this neighbourhood, I believe
-
-there are few neighbourhoods larger.  I know we dine with
-
-four-and-twenty families."
-
-
-Nothing but concern for Elizabeth could enable Bingley to keep
-
-his countenance.  His sister was less delicate, and directed her
-
-eyes towards Mr. Darcy with a very expressive smile.  Elizabeth,
-
-for the sake of saying something that might turn her mother's
-
-thoughts, now asked her if Charlotte Lucas had been at
-
-Longbourn since HER coming away.
-
-
-"Yes, she called yesterday with her father.  What an agreeable
-
-man Sir William is, Mr. Bingley, is not he?  So much the man of
-
-fashion!  So genteel and easy!  He had always something to say
-
-to everybody.  THAT is my idea of good breeding; and those
-
-persons who fancy themselves very important, and never open
-
-their mouths, quite mistake the matter."
-
-
-"Did Charlotte dine with you?"
-
-
-"No, she would go home.  I fancy she was wanted about the
-
-mince-pies.  For my part, Mr. Bingley, I always keep servants
-
-that can do their own work; MY daughters are brought up very
-
-differently.  But everybody is to judge for themselves, and the
-
-Lucases are a very good sort of girls, I assure you.  It is a pity
-
-they are not handsome!  Not that I think Charlotte so VERY
-
-plain--but then she is our particular friend."
-
-
-"She seems a very pleasant young woman."
-
-
-"Oh! dear, yes; but you must own she is very plain.  Lady Lucas
-
-herself has often said so, and envied me Jane's beauty.  I do not
-
-like to boast of my own child, but to be sure, Jane--one does
-
-not often see anybody better looking.  It is what everybody says.
-
-I do not trust my own partiality.  When she was only fifteen,
-
-there was a man at my brother Gardiner's in town so much in
-
-love with her that my sister-in-law was sure he would make her
-
-an offer before we came away.  But, however, he did not.
-
-Perhaps he thought her too young.  However, he wrote some
-
-verses on her, and very pretty they were."
-
-
-"And so ended his affection," said Elizabeth impatiently.  "There
-
-has been many a one, I fancy, overcome in the same way.  I
-
-wonder who first discovered the efficacy of poetry in driving
-
-away love!"
-
-
-"I have been used to consider poetry as the FOOD of love," said
-
-Darcy.
-
-
-"Of  a fine, stout, healthy love it may.  Everything nourishes
-
-what is strong already.  But if it be only a slight, thin sort of
-
-inclination, I am convinced that one good sonnet will starve it
-
-entirely away."
-
-
-Darcy only smiled; and the general pause which ensued made
-
-Elizabeth tremble lest her mother should be exposing herself
-
-again.  She longed to speak, but could think of nothing to say;
-
-and after a short silence Mrs. Bennet began repeating her thanks
-
-to Mr. Bingley for his kindness to Jane, with an apology for
-
-troubling him also with Lizzy.  Mr. Bingley was unaffectedly
-
-civil in his answer, and forced his younger sister to be civil
-
-also, and say what the occasion required.  She performed her
-
-part indeed without much graciousness, but Mrs. Bennet was
-
-satisfied, and soon afterwards ordered her carriage.  Upon this
-
-signal, the youngest of her daughters put herself forward.  The
-
-two girls had been whispering to each other during the whole
-
-visit, and the result of it was, that the youngest should tax
-
-Mr. Bingley with having promised on his first coming into the
-
-country to give a ball at Netherfield.
-
-
-Lydia was a stout, well-grown girl of fifteen, with a fine
-
-complexion and good-humoured countenance; a favourite with her
-
-mother, whose affection had brought her into public at an early
-
-age.  She had high animal spirits, and a sort of natural
-
-self-consequence, which the attention of the officers, to whom
-
-her uncle's good dinners, and her own easy manners recommended
-
-her, had increased into assurance.  She was very equal,
-
-therefore, to address Mr. Bingley on the subject of the ball, and
-
-abruptly reminded him of his promise; adding, that it would be
-
-the most shameful thing in the world if he did not keep it.  His
-
-answer to this sudden attack was delightful to their mother's ear:
-
-
-"I am perfectly ready, I assure you, to keep my engagement; and
-
-when your sister is recovered, you shall, if you please, name the
-
-very day of the ball.  But you would not wish to be dancing
-
-when she is ill."
-
-
-Lydia declared herself satisfied.  "Oh! yes--it would be much
-
-better to wait till Jane was well, and by that time most likely
-
-Captain Carter would be at Meryton again.  And when you have
-
-given YOUR ball," she added, "I shall insist on their giving one
-
-also.  I shall tell Colonel Forster it will be quite a shame if he
-
-does not."
-
-
-Mrs. Bennet and her daughters then departed, and Elizabeth
-
-returned instantly to Jane, leaving her own and her relations'
-
-behaviour to the remarks of the two ladies and Mr. Darcy; the
-
-latter of whom, however, could not be prevailed on to join in
-
-their censure of HER, in spite of all Miss Bingley's witticisms on
-
-FINE EYES.
-
-
-
-
-Chapter 10
-
-
-
-The day passed much as the day before had done.  Mrs. Hurst
-
-and Miss Bingley had spent some hours of the morning with the
-
-invalid, who continued, though slowly, to mend; and in the
-
-evening Elizabeth joined their party in the drawing-room.  The
-
-loo-table, however, did not appear.  Mr. Darcy was writing, and
-
-Miss Bingley, seated near him, was watching the progress of his
-
-letter and repeatedly calling off his attention by messages to
-
-his sister.  Mr. Hurst and Mr. Bingley were at piquet, and Mrs.
-
-Hurst was observing their game.
-
-
-Elizabeth took up some needlework, and was sufficiently
-
-amused in attending to what passed between Darcy and his
-
-companion.  The perpetual commendations of the lady, either on
-
-his handwriting, or on the evenness of his lines, or on the length
-
-of his letter, with the perfect unconcern with which her praises
-
-were received, formed a curious dialogue, and was exactly in
-
-union with her opinion of each.
-
-
-"How delighted Miss Darcy will be to receive such a letter!"
-
-
-He made no answer.
-
-
-"You write uncommonly fast."
-
-
-"You are mistaken.  I write rather slowly."
-
-
-"How many letters you must have occasion to write in the
-
-course of a year!  Letters of business, too!  How odious I should
-
-think them!"
-
-
-"It is fortunate, then, that they fall to my lot instead of yours."
-
-
-"Pray tell your sister that I long to see her."
-
-
-"I have already told her so once, by your desire."
-
-
-"I am afraid you do not like your pen.  Let me mend it for you.
-
-I mend pens remarkably well."
-
-
-"Thank you--but I always mend my own."
-
-
-"How can you contrive to write so even?"
-
-
-He was silent.
-
-
-"Tell your sister I am delighted to hear of her improvement on
-
-the harp; and pray let her know that I am quite in raptures with
-
-her beautiful little design for a table, and I think it infinitely
-
-superior to Miss Grantley's."
-
-
-"Will you give me leave to defer your raptures till I write again?
-
-At present I have not room to do them justice."
-
-
-"Oh! it is of no consequence.  I shall see her in January.  But do
-
-you always write such charming long letters to her, Mr. Darcy?"
-
-
-"They are generally long; but whether always charming it is not
-
-for me to determine."
-
-
-"It is a rule with me, that a person who can write a long letter
-
-with ease, cannot write ill."
-
-
-"That will not do for a compliment to Darcy, Caroline," cried
-
-her brother, "because he does NOT write with ease.  He studies
-
-too much for words of four syllables.  Do not you, Darcy?"
-
-
-"My style of writing is very different from yours."
-
-
-"Oh!" cried Miss Bingley, "Charles writes in the most careless
-
-way imaginable.  He leaves out half his words, and blots the
-
-rest."
-
-
-"My ideas flow so rapidly that I have not time to express
-
-them--by which means my letters sometimes convey no ideas
-
-at all to my correspondents."
-
-
-"Your humility, Mr. Bingley," said Elizabeth, "must disarm
-
-reproof."
-
-
-"Nothing is more deceitful," said Darcy, "than the appearance of
-
-humility.  It is often only carelessness of opinion, and sometimes
-
-an indirect boast."
-
-
-"And which of the two do you call MY little recent piece of
-
-modesty?"
-
-
-"The indirect boast; for you are really proud of your defects in
-
-writing, because you consider them as proceeding from a
-
-rapidity of thought and carelessness of execution, which, if not
-
-estimable, you think at least highly interesting.  The power of
-
-doing anything with quickness is always prized much by the
-
-possessor, and often without any attention to the imperfection of
-
-the performance.  When you told Mrs. Bennet this morning that
-
-if you ever resolved upon quitting Netherfield you should be
-
-gone in five minutes, you meant it to be a sort of panegyric, of
-
-compliment to yourself--and yet what is there so very laudable
-
-in a precipitance which must leave very necessary business
-
-undone, and can be of no real advantage to yourself or anyone
-
-else?"
-
-
-"Nay," cried Bingley, "this is too much, to remember at night all
-
-the foolish things that were said in the morning.  And yet, upon
-
-my honour, I believe what I said of myself to be true, and I
-
-believe it at this moment.  At least, therefore, I did not assume
-
-the character of needless precipitance merely to show off before
-
-the ladies."
-
-
-"I dare say you believed it; but I am by no means convinced that
-
-you would be gone with such celerity.  Your conduct would be
-
-quite as dependent on chance as that of any man I know; and if,
-
-as you were mounting your horse, a friend were to say,  'Bingley,
-
-you had better stay till next week,' you would probably do it,
-
-you would probably not go--and at another word, might stay a
-
-month."
-
-
-"You have only proved by this," cried Elizabeth, "that Mr.
-
-Bingley did not do justice to his own disposition.  You have
-
-shown him off now much more than he did himself."
-
-
-"I am exceedingly gratified," said Bingley, "by your converting
-
-what my friend says into a compliment on the sweetness of my
-
-temper.  But I am afraid you are giving it a turn which that
-
-gentleman did by no means intend; for he would certainly think
-
-better of me, if under such a circumstance I were to give a flat
-
-denial, and ride off as fast as I could."
-
-
-"Would Mr. Darcy then consider the rashness of your original
-
-intentions as atoned for by your obstinacy in adhering to it?"
-
-
-"Upon my word, I cannot exactly explain the matter; Darcy must
-
-speak for himself."
-
-
-"You expect me to account for opinions which you choose to
-
-call mine, but which I have never acknowledged.  Allowing the
-
-case, however, to stand according to your representation, you
-
-must remember, Miss Bennet, that the friend who is supposed to
-
-desire his return to the house, and the delay of his plan, has
-
-merely desired it, asked it without offering one argument in
-
-favour of its propriety."
-
-
-"To yield readily--easily--to the PERSUASION of a friend is
-
-no merit with you."
-
-
-"To yield without conviction is no compliment to the understanding
-
-of either."
-
-
-"You appear to me, Mr. Darcy, to allow nothing for the
-
-influence of friendship and affection.  A regard for the requester
-
-would often make one readily yield to a request, without waiting
-
-for arguments to reason one into it.  I am not particularly
-
-speaking of such a case as you have supposed about Mr.
-
-Bingley.  We may as well wait, perhaps, till the circumstance
-
-occurs before we discuss the discretion of his behaviour
-
-thereupon.  But in general and ordinary cases between friend and
-
-friend, where one of them is desired by the other to change a
-
-resolution of no very great moment, should you think ill of that
-
-person for complying with the desire, without waiting to be
-
-argued into it?"
-
-
-"Will it not be advisable, before we proceed on this subject, to
-
-arrange with rather more precision the degree of importance
-
-which is to appertain to this request, as well as the degree of
-
-intimacy subsisting between the parties?"
-
-
-"By all means," cried Bingley; "let us hear all the particulars,
-
-not forgetting their comparative height and size; for that will
-
-have more weight in the argument, Miss Bennet, than you may be
-
-aware of.  I assure you, that if Darcy were not such a great tall
-
-fellow, in comparison with myself, I should not pay him half so
-
-much deference.  I declare I do not know a more awful object
-
-than Darcy, on particular occasions, and in particular places; at
-
-his own house especially, and of a Sunday evening, when he has
-
-nothing to do."
-
-
-Mr. Darcy smiled; but Elizabeth thought she could perceive that
-
-he was rather offended, and therefore checked her laugh.  Miss
-
-Bingley warmly resented the indignity he had received, in an
-
-expostulation with her brother for talking such nonsense.
-
-
-"I see your design, Bingley," said his friend.  "You dislike an
-
-argument, and want to silence this."
-
-
-"Perhaps I do.  Arguments are too much like disputes.  If you and
-
-Miss Bennet will defer yours till I am out of the room, I shall
-
-be very thankful; and then you may say whatever you like of me."
-
-
-"What you ask," said Elizabeth, "is no sacrifice on my side; and
-
-Mr. Darcy had much better finish his letter."
-
-
-Mr. Darcy took her advice, and did finish his letter.
-
-
-When that business was over, he applied to Miss Bingley and
-
-Elizabeth for an indulgence of some music.  Miss Bingley moved
-
-with some alacrity to the pianoforte; and, after a polite request
-
-that Elizabeth would lead the way which the other as politely
-
-and more earnestly negatived, she seated herself.
-
-
-Mrs. Hurst sang with her sister, and while they were thus
-
-employed, Elizabeth could not help observing, as she turned
-
-over some music-books that lay on the instrument, how frequently
-
-Mr. Darcy's eyes were fixed on her.  She hardly knew how to
-
-suppose that she could be an object of admiration to so great a
-
-man; and yet that he should look at her because he disliked her,
-
-was still more strange.  She could only imagine, however, at last
-
-that she drew his notice because there was something more wrong
-
-and reprehensible, according to his ideas of right, than in any
-
-other person present.  The supposition did not pain her.  She
-
-liked him too little to care for his approbation.
-
-
-After playing some Italian songs, Miss Bingley varied the charm
-
-by a lively Scotch air; and soon afterwards Mr. Darcy, drawing
-
-near Elizabeth, said to her:
-
-
-"Do not you feel a great inclination, Miss Bennet, to seize such
-
-an opportunity of dancing a reel?"
-
-
-She smiled, but made no answer.  He repeated the question, with
-
-some surprise at her silence.
-
-
-"Oh!" said she, "I heard you before, but I could not immediately
-
-determine what to say in reply.  You wanted me, I know, to say
-
-'Yes,' that you might have the pleasure of despising my taste;
-
-but I always delight in overthrowing those kind of schemes,
-
-and cheating a person of their premeditated contempt.  I have,
-
-therefore, made up my mind to tell you, that I do not want to
-
-dance a reel at all--and now despise me if you dare."
-
-
-"Indeed I do not dare."
-
-
-Elizabeth, having rather expected to affront him, was amazed at
-
-his gallantry; but there was a mixture of sweetness and archness
-
-in her manner which made it difficult for her to affront anybody;
-
-and Darcy had never been so bewitched by any woman as he
-
-was by her.  He really believed, that were it not for the
-
-inferiority of her connections, he should be in some danger.
-
-
-Miss Bingley saw, or suspected enough to be jealous; and her
-
-great anxiety for the recovery of her dear friend Jane received
-
-some assistance from her desire of getting rid of Elizabeth.
-
-
-She often tried to provoke Darcy into disliking her guest, by
-
-talking of their supposed marriage, and planning his happiness in
-
-such an alliance.
-
-
-"I hope," said she, as they were walking together in the
-
-shrubbery the next day, "you will give your mother-in-law a few
-
-hints, when this desirable event takes place, as to the advantage
-
-of holding her tongue; and if you can compass it, do sure the
-
-younger girls of running after officers.  And, if I may mention so
-
-delicate a subject, endeavour to check that little something,
-
-bordering on conceit and impertinence, which your lady
-
-possesses."
-
-
-"Have you anything else to propose for my domestic felicity?"
-
-
-"Oh! yes.  Do let the portraits of your uncle and aunt Phillips be
-
-placed in the gallery at Pemberley.  Put them next to your
-
-great-uncle the judge.  They are in the same profession, you
-
-know, only in different lines.  As for your Elizabeth's picture, you
-
-must not have it taken, for what painter could do justice to those
-
-beautiful eyes?"
-
-
-"It would not be easy, indeed, to catch their expression, but their
-
-colour and shape, and the eyelashes, so remarkably fine, might
-
-be copied."
-
-
-At that moment they were met from another walk by Mrs. Hurst
-
-and Elizabeth herself.
-
-
-"I did not know that you intended to walk," said Miss Bingley,
-
-in some confusion, lest they had been overheard.
-
-
-"You used us abominably ill," answered Mrs. Hurst, "running
-
-away without telling us that you were coming out."
-
-
-Then taking the disengaged arm of Mr. Darcy, she left Elizabeth
-
-to walk by herself.  The path just admitted three.  Mr. Darcy felt
-
-their rudeness, and immediately said:
-
-
-"This walk is not wide enough for our party.  We had better go
-
-into the avenue."
-
-
-But Elizabeth, who had not the least inclination to remain with
-
-them, laughingly answered:
-
-
-"No, no; stay where you are.  You are charmingly grouped, and
-
-appear to uncommon advantage.  The picturesque would be
-
-spoilt by admitting a fourth.  Good-bye."
-
-
-She then ran gaily off, rejoicing as she rambled about, in the
-
-hope of being at home again in a day or two.  Jane was already
-
-so much recovered as to intend leaving her room for a couple of
-
-hours that evening.
-
-
-
-
->
-
-[Embedded]
-00102023
diff --git a/test/Lwp/austin.txt b/test/Lwp/austin.txt
deleted file mode 100644
index 580827306..000000000
--- a/test/Lwp/austin.txt
+++ /dev/null
@@ -1,1979 +0,0 @@
-Pride and Prejudice
-
-by Jane Austen
-
-
-
-
-Chapter 1
-
-
-It is a truth universally acknowledged, that a single man in
-possession of a good fortune, must be in want of a wife.
-
-However little known the feelings or views of such a man may
-be on his first entering a neighbourhood, this truth is so well
-fixed in the minds of the surrounding families, that he is considered
-the rightful property of some one or other of their daughters.
-
-"My dear Mr. Bennet," said his lady to him one day, "have you
-heard that Netherfield Park is let at last?"
-
-Mr. Bennet replied that he had not.
-
-"But it is," returned she; "for Mrs. Long has just been here, and
-she told me all about it."
-
-Mr. Bennet made no answer.
-
-"Do you not want to know who has taken it?" cried his wife
-impatiently.
-
-"YOU want to tell me, and I have no objection to hearing it."
-
-This was invitation enough.
-
-"Why, my dear, you must know, Mrs. Long says that Netherfield
-is taken by a young man of large fortune from the north of
-England; that he came down on Monday in a chaise and four to
-see the place, and was so much delighted with it, that he agreed
-with Mr. Morris immediately; that he is to take possession
-before Michaelmas, and some of his servants are to be in the
-house by the end of next week."
-
-"What is his name?"
-
-"Bingley."
-
-"Is he married or single?"
-
-"Oh!  Single, my dear, to be sure!  A single man of large
-fortune; four or five thousand a year.  What a fine thing for our
-girls!"
-
-"How so?  How can it affect them?"
-
-"My dear Mr. Bennet," replied his wife, "how can you be so
-tiresome!  You must know that I am thinking of his marrying
-one of them."
-
-"Is that his design in settling here?"
-
-"Design!  Nonsense, how can you talk so!  But it is very likely
-that he MAY fall in love with one of them, and therefore you
-must visit him as soon as he comes."
-
-"I see no occasion for that.  You and the girls may go, or you
-may send them by themselves, which perhaps will be still
-better, for as you are as handsome as any of them, Mr. Bingley
-may like you the best of the party."
-
-"My dear, you flatter me.  I certainly HAVE had my share of
-beauty, but I do not pretend to be anything extraordinary now.
-When a woman has five grown-up daughters, she ought to give
-over thinking of her own beauty."
-
-"In such cases, a woman has not often much beauty to think of."
-
-"But, my dear, you must indeed go and see Mr. Bingley when
-he comes into the neighbourhood."
-
-"It is more than I engage for, I assure you."
-
-"But consider your daughters.  Only think what an establishment
-it would be for one of them.  Sir William and Lady Lucas are
-determined to go, merely on that account, for in general, you
-know, they visit no newcomers.  Indeed you must go, for it will
-be impossible for US to visit him if you do not."
-
-"You are over-scrupulous, surely.  I dare say Mr. Bingley will
-be very glad to see you; and I will send a few lines by you to
-assure him of my hearty consent to his marrying whichever he
-chooses of the girls; though I must throw in a good word for
-my little Lizzy."
-
-"I desire you will do no such thing.  Lizzy is not a bit better
-than the others; and I am sure she is not half so handsome as
-Jane, nor half so good-humoured as Lydia.  But you are always
-giving HER the preference."
-
-"They have none of them much to recommend them," replied he;
-"they are all silly and ignorant like other girls; but Lizzy
-has something more of quickness than her sisters."
-
-"Mr. Bennet, how CAN you abuse your own children in such a
-way?  You take delight in vexing me.  You have no compassion
-for my poor nerves."
-
-"You mistake me, my dear.  I have a high respect for your
-nerves.  They are my old friends.  I have heard you mention
-them with consideration these last twenty years at least."
-
-Mr. Bennet was so odd a mixture of quick parts, sarcastic humour,
-reserve, and caprice, that the experience of three-and-twenty
-years had been insufficient to make his wife understand his
-character.  HER mind was less difficult to develop.  She was a
-woman of mean understanding, little information, and uncertain
-temper.  When she was discontented, she fancied herself nervous.
-The business of her life was to get her daughters married; its
-solace was visiting and news.
-
-
-
-Chapter 2
-
-
-Mr. Bennet was among the earliest of those who waited on Mr.
-Bingley.  He had always intended to visit him, though to the last
-always assuring his wife that he should not go; and till the
-evening after the visit was paid she had no knowledge of it.
-It was then disclosed in the following manner.  Observing his
-second daughter employed in trimming a hat, he suddenly
-addressed her with:
-
-"I hope Mr. Bingley will like it, Lizzy."
-
-"We are not in a way to know WHAT Mr. Bingley likes," said
-her mother resentfully, "since we are not to visit."
-
-"But you forget, mamma," said Elizabeth, "that we shall meet
-him at the assemblies, and that Mrs. Long promised to introduce
-him."
-
-"I do not believe Mrs. Long will do any such thing.  She has two
-nieces of her own.  She is a selfish, hypocritical woman, and I
-have no opinion of her."
-
-"No more have I," said Mr. Bennet; "and I am glad to find that
-you do not depend on her serving you."
-
-Mrs. Bennet deigned not to make any reply, but, unable to
-contain herself, began scolding one of her daughters.
-
-"Don't keep coughing so, Kitty, for Heaven's sake!  Have a little
-compassion on my nerves.  You tear them to pieces."
-
-"Kitty has no discretion in her coughs," said her father; "she
-times them ill."
-
-"I do not cough for my own amusement," replied Kitty fretfully.
-"When is your next ball to be, Lizzy?"
-
-"To-morrow fortnight."
-
-"Aye, so it is," cried her mother, "and Mrs. Long does not come
-back till the day before; so it will be impossible for her to
-introduce him, for she will not know him herself."
-
-"Then, my dear, you may have the advantage of your friend, and
-introduce Mr. Bingley to HER."
-
-"Impossible, Mr. Bennet, impossible, when I am not acquainted
-with him myself; how can you be so teasing?"
-
-"I honour your circumspection.  A fortnight's acquaintance is
-certainly very little.  One cannot know what a man really is by
-the end of a fortnight.  But if WE do not venture somebody else
-will; and after all, Mrs. Long and her daughters must stand their
-chance; and, therefore, as she will think it an act of kindness,
-if you decline the office, I will take it on myself."
-
-The girls stared at their father.  Mrs. Bennet said only,
-"Nonsense, nonsense!"
-
-"What can be the meaning of that emphatic exclamation?" cried
-he.  "Do you consider the forms of introduction, and the stress
-that is laid on them, as nonsense?  I cannot quite agree with
-you THERE.  What say you, Mary?  For you are a young lady of
-deep reflection, I know, and read great books and make extracts."
-
-Mary wished to say something sensible, but knew not how.
-
-"While Mary is adjusting her ideas," he continued, "let us return
-to Mr. Bingley."
-
-"I am sick of Mr. Bingley," cried his wife.
-
-"I am sorry to hear THAT; but why did not you tell me that
-before?  If I had known as much this morning I certainly would
-not have called on him.  It is very unlucky; but as I have
-actually paid the visit, we cannot escape the acquaintance now."
-
-The astonishment of the ladies was just what he wished; that of
-Mrs. Bennet perhaps surpassing the rest; though, when the first
-tumult of joy was over, she began to declare that it was what she
-had expected all the while.
-
-"How good it was in you, my dear Mr. Bennet!  But I knew I should
-persuade you at last.  I was sure you loved your girls too well
-to neglect such an acquaintance.  Well, how pleased I am! and it
-is such a good joke, too, that you should have gone this morning
-and never said a word about it till now."
-
-"Now, Kitty, you may cough as much as you choose," said Mr.
-Bennet; and, as he spoke, he left the room, fatigued with the
-raptures of his wife.
-
-"What an excellent father you have, girls!" said she, when the
-door was shut.  "I do not know how you will ever make him
-amends for his kindness; or me, either, for that matter.  At our
-time of life it is not so pleasant, I can tell you, to be making
-new acquaintances every day; but for your sakes, we would do
-anything.  Lydia, my love, though you ARE the youngest, I dare
-say Mr. Bingley will dance with you at the next ball."
-
-"Oh!" said Lydia stoutly, "I am not afraid; for though I AM the
-youngest, I'm the tallest."
-
-The rest of the evening was spent in conjecturing how soon he
-would return Mr. Bennet's visit, and determining when they
-should ask him to dinner.
-
-
-
-Chapter 3
-
-
-Not all that Mrs. Bennet, however, with the assistance of her
-five daughters, could ask on the subject, was sufficient to draw
-from her husband any satisfactory description of Mr. Bingley.
-They attacked him in various ways--with barefaced questions,
-ingenious suppositions, and distant surmises; but he eluded the
-skill of them all, and they were at last obliged to accept the
-second-hand intelligence of their neighbour, Lady Lucas.  Her
-report was highly favourable.  Sir William had been delighted
-with him.  He was quite young, wonderfully handsome, extremely
-agreeable, and, to crown the whole, he meant to be at the next
-assembly with a large party.  Nothing could be more delightful!
-To be fond of dancing was a certain step towards falling in love;
-and very lively hopes of Mr. Bingley's heart were entertained.
-
-"If I can but see one of my daughters happily settled at
-Netherfield," said Mrs. Bennet to her husband, "and all the
-others equally well married, I shall have nothing to wish for."
-
-In a few days Mr. Bingley returned Mr. Bennet's visit, and sat
-about ten minutes with him in his library.  He had entertained
-hopes of being admitted to a sight of the young ladies, of
-whose beauty he had heard much; but he saw only the father.
-The ladies were somewhat more fortunate, for they had the
-advantage of ascertaining from an upper window that he wore
-a blue coat, and rode a black horse.
-
-An invitation to dinner was soon afterwards dispatched; and
-already had Mrs. Bennet planned the courses that were to do
-credit to her housekeeping, when an answer arrived which
-deferred it all.  Mr. Bingley was obliged to be in town the
-following day, and, consequently, unable to accept the honour
-of their invitation, etc.  Mrs. Bennet was quite disconcerted.
-She could not imagine what business he could have in town so
-soon after his arrival in Hertfordshire; and she began to fear
-that he might be always flying about from one place to another,
-and never settled at Netherfield as he ought to be.  Lady Lucas
-quieted her fears a little by starting the idea of his being gone
-to London only to get a large party for the ball; and a report
-soon followed that Mr. Bingley was to bring twelve ladies and
-seven gentlemen with him to the assembly.  The girls grieved
-over such a number of ladies, but were comforted the day
-before the ball by hearing, that instead of twelve he brought
-only six with him from London--his five sisters and a cousin.
-And when the party entered the assembly room it consisted of
-only five altogether--Mr. Bingley, his two sisters, the husband
-of the eldest, and another young man.
-
-Mr. Bingley was good-looking and gentlemanlike; he had a pleasant
-countenance, and easy, unaffected manners.  His sisters were fine
-women, with an air of decided fashion.  His brother-in-law, Mr.
-Hurst, merely looked the gentleman; but his friend Mr. Darcy soon
-drew the attention of the room by his fine, tall person, handsome
-features, noble mien, and the report which was in general
-circulation within five minutes after his entrance, of his having
-ten thousand a year.  The gentlemen pronounced him to be a fine
-figure of a man, the ladies declared he was much handsomer than
-Mr. Bingley, and he was looked at with great admiration for about
-half the evening, till his manners gave a disgust which turned
-the tide of his popularity; for he was discovered to be proud;
-to be above his company, and above being pleased; and not all his
-large estate in Derbyshire could then save him from having a most
-forbidding, disagreeable countenance, and being unworthy to be
-compared with his friend.
-
-Mr. Bingley had soon made himself acquainted with all the
-principal people in the room; he was lively and unreserved,
-danced every dance, was angry that the ball closed so early,
-and talked of giving one himself at Netherfield.  Such amiable
-qualities must speak for themselves.  What a contrast between
-him and his friend!  Mr. Darcy danced only once with Mrs. Hurst
-and once with Miss Bingley, declined being introduced to any
-other lady, and spent the rest of the evening in walking about
-the room, speaking occasionally to one of his own party.  His
-character was decided.  He was the proudest, most disagreeable
-man in the world, and everybody hoped that he would never come
-there again.  Amongst the most violent against him was Mrs.
-Bennet, whose dislike of his general behaviour was sharpened
-into particular resentment by his having slighted one of her
-daughters.
-
-Elizabeth Bennet had been obliged, by the scarcity of gentlemen,
-to sit down for two dances; and during part of that time,
-Mr. Darcy had been standing near enough for her to hear a
-conversation between him and Mr. Bingley, who came from the
-dance for a few minutes, to press his friend to join it.
-
-"Come, Darcy," said he, "I must have you dance.  I hate to see
-you standing about by yourself in this stupid manner.  You had
-much better dance."
-
-"I certainly shall not.  You know how I detest it, unless I am
-particularly acquainted with my partner.  At such an assembly as
-this it would be insupportable.  Your sisters are engaged, and
-there is not another woman in the room whom it would not be a
-punishment to me to stand up with."
-
-"I would not be so fastidious as you are," cried Mr. Bingley,
-"for a kingdom!  Upon my honour, I never met with so many
-pleasant girls in my life as I have this evening; and there are
-several of them you see uncommonly pretty."
-
-"YOU are dancing with the only handsome girl in the room,"
-said Mr. Darcy, looking at the eldest Miss Bennet.
-
-"Oh! She is the most beautiful creature I ever beheld!  But
-there is one of her sisters sitting down just behind you, who is
-very pretty, and I dare say very agreeable.  Do let me ask my
-partner to introduce you."
-
-"Which do you mean?" and turning round he looked for a
-moment at Elizabeth, till catching her eye, he withdrew his own
-and coldly said: "She is tolerable, but not handsome enough to
-tempt ME; I am in no humour at present to give consequence
-to young ladies who are slighted by other men.  You had better
-return to your partner and enjoy her smiles, for you are wasting
-your time with me."
-
-Mr. Bingley followed his advice.  Mr. Darcy walked off; and
-Elizabeth remained with no very cordial feelings toward him.
-She told the story, however, with great spirit among her friends;
-for she had a lively, playful disposition, which delighted in
-anything ridiculous.
-
-The evening altogether passed off pleasantly to the whole
-family.  Mrs. Bennet had seen her eldest daughter much
-admired by the Netherfield party.  Mr. Bingley had danced with
-her twice, and she had been distinguished by his sisters.  Jane
-was as much gratified by this as her mother could be, though in
-a quieter way.  Elizabeth felt Jane's pleasure.  Mary had heard
-herself mentioned to Miss Bingley as the most accomplished
-girl in the neighbourhood; and Catherine and Lydia had been
-fortunate enough never to be without partners, which was all
-that they had yet learnt to care for at a ball.  They returned,
-therefore, in good spirits to Longbourn, the village where they
-lived, and of which they were the principal inhabitants.  They
-found Mr. Bennet still up.  With a book he was regardless of
-time; and on the present occasion he had a good deal of
-curiosity as to the events of an evening which had raised such
-splendid expectations.  He had rather hoped that his wife's
-views on the stranger would be disappointed; but he soon
-found out that he had a different story to hear.
-
-"Oh! my dear Mr. Bennet," as she entered the room, "we have
-had a most delightful evening, a most excellent ball.  I wish you
-had been there.  Jane was so admired, nothing could be like it.
-Everybody said how well she looked; and Mr. Bingley thought
-her quite beautiful, and danced with her twice!  Only think of
-THAT, my dear; he actually danced with her twice! and she was
-the only creature in the room that he asked a second time.
-First of all, he asked Miss Lucas.  I was so vexed to see him
-stand up with her!  But, however, he did not admire her at all;
-indeed, nobody can, you know; and he seemed quite struck with
-Jane as she was going down the dance.  So he inquired who she
-was, and got introduced, and asked her for the two next.  Then
-the two third he danced with Miss King, and the two fourth with
-Maria Lucas, and the two fifth with Jane again, and the two
-sixth with Lizzy, and the BOULANGER--"
-
-"If he had had any compassion for ME," cried her husband
-impatiently, "he would not have danced half so much!  For God's
-sake, say no more of his partners.  O that he had sprained
-his ankle in the first place!"
-
-"Oh! my dear, I am quite delighted with him.  He is so
-excessively handsome!  And his sisters are charming women.
-I never in my life saw anything more elegant than their dresses.
-I dare say the lace upon Mrs. Hurst's gown--"
-
-Here she was interrupted again.  Mr. Bennet protested against
-any description of finery.  She was therefore obliged to seek
-another branch of the subject, and related, with much bitterness
-of spirit and some exaggeration, the shocking rudeness of Mr.
-Darcy.
-
-"But I can assure you," she added, "that Lizzy does not lose
-much by not suiting HIS fancy; for he is a most disagreeable,
-horrid man, not at all worth pleasing.  So high and so conceited
-that there was no enduring him!  He walked here, and he walked
-there, fancying himself so very great!  Not handsome enough to
-dance with!  I wish you had been there, my dear, to have given
-him one of your set-downs.  I quite detest the man."
-
-
-
-Chapter 4
-
-
-When Jane and Elizabeth were alone, the former, who had been
-cautious in her praise of Mr. Bingley before, expressed to her
-sister just how very much she admired him.
-
-"He is just what a young man ought to be," said she, "sensible,
-good-humoured, lively; and I never saw such happy manners!--so
-much ease, with such perfect good breeding!"
-
-"He is also handsome," replied Elizabeth, "which a young man
-ought likewise to be, if he possibly can.  His character is thereby
-complete."
-
-"I was very much flattered by his asking me to dance a second
-time.  I did not expect such a compliment."
-
-"Did not you? I did for you.  But that is one great difference
-between us.  Compliments always take YOU by surprise, and
-ME never.  What could be more natural than his asking you
-again?  He could not help seeing that you were about five times
-as pretty as every other woman in the room.  No thanks to his
-gallantry for that.  Well, he certainly is very agreeable, and I
-give you leave to like him.  You have liked many a stupider
-person."
-
-"Dear Lizzy!"
-
-"Oh! you are a great deal too apt, you know, to like people in
-general.  You never see a fault in anybody.  All the world are
-good and agreeable in your eyes.  I never heard you speak ill of
-a human being in your life."
-
-"I would not wish to be hasty in censuring anyone; but I always
-speak what I think."
-
-"I know you do; and it is THAT which makes the wonder.  With YOUR
-good sense, to be so honestly blind to the follies and nonsense
-of others!  Affectation of candour is common enough--one meets
-with it everywhere.  But to be candid without ostentation or
-design--to take the good of everybody's character and make it
-still better, and say nothing of the bad--belongs to you alone.
-And so you like this man's sisters, too, do you?  Their manners
-are not equal to his."
-
-"Certainly not--at first.  But they are very pleasing women when
-you converse with them.  Miss Bingley is to live with her
-brother, and keep his house; and I am much mistaken if we shall
-not find a very charming neighbour in her."
-
-Elizabeth listened in silence, but was not convinced; their
-behaviour at the assembly had not been calculated to please in
-general; and with more quickness of observation and less pliancy
-of temper than her sister, and with a judgement too unassailed by
-any attention to herself, she was very little disposed to approve
-them.  They were in fact very fine ladies; not deficient in good
-humour when they were pleased, nor in the power of making
-themselves agreeable when they chose it, but proud and
-conceited.  They were rather handsome, had been educated in
-one of the first private seminaries in town, had a fortune of
-twenty thousand pounds, were in the habit of spending more
-than they ought, and of associating with people of rank, and
-were therefore in every respect entitled to think well of
-themselves, and meanly of others.  They were of a respectable
-family in the north of England; a circumstance more deeply
-impressed on their memories than that their brother's fortune
-and their own had been acquired by trade.
-
-Mr. Bingley inherited property to the amount of nearly a
-hundred thousand pounds from his father, who had intended to
-purchase an estate, but did not live to do it.  Mr. Bingley
-intended it likewise, and sometimes made choice of his county;
-but as he was now provided with a good house and the liberty of
-a manor, it was doubtful to many of those who best knew the
-easiness of his temper, whether he might not spend the
-remainder of his days at Netherfield, and leave the next
-generation to purchase.
-
-His sisters were anxious for his having an estate of his own; but,
-though he was now only established as a tenant, Miss Bingley
-was by no means unwilling to preside at his table--nor was Mrs.
-Hurst, who had married a man of more fashion than fortune, less
-disposed to consider his house as her home when it suited her.
-Mr. Bingley had not been of age two years, when he was tempted
-by an accidental recommendation to look at Netherfield House.
-He did look at it, and into it for half-an-hour--was pleased with
-the situation and the principal rooms, satisfied with what the
-owner said in its praise, and took it immediately.
-
-Between him and Darcy there was a very steady friendship, in
-spite of great opposition of character.  Bingley was endeared to
-Darcy by the easiness, openness, and ductility of his temper,
-though no disposition could offer a greater contrast to his own,
-and though with his own he never appeared dissatisfied.  On the
-strength of Darcy's regard, Bingley had the firmest reliance, and
-of his judgement the highest opinion.  In understanding, Darcy
-was the superior.  Bingley was by no means deficient, but Darcy
-was clever.  He was at the same time haughty, reserved, and
-fastidious, and his manners, though well-bred, were not inviting.
-In that respect his friend had greatly the advantage.  Bingley was
-sure of being liked wherever he appeared, Darcy was continually
-giving offense.
-
-The manner in which they spoke of the Meryton assembly was
-sufficiently characteristic.  Bingley had never met with more
-pleasant people or prettier girls in his life; everybody had been
-most kind and attentive to him; there had been no formality, no
-stiffness; he had soon felt acquainted with all the room; and, as
-to Miss Bennet, he could not conceive an angel more beautiful.
-Darcy, on the contrary, had seen a collection of people in whom
-there was little beauty and no fashion, for none of whom he had
-felt the smallest interest, and from none received either attention
-or pleasure.  Miss Bennet he acknowledged to be pretty, but she
-smiled too much.
-
-Mrs. Hurst and her sister allowed it to be so--but still they
-admired her and liked her, and pronounced her to be a sweet
-girl, and one whom they would not object to know more of.
-Miss Bennet was therefore established as a sweet girl, and their
-brother felt authorized by such commendation to think of her as
-he chose.
-
-
-
-Chapter 5
-
-
-Within a short walk of Longbourn lived a family with whom
-the Bennets were particularly intimate.  Sir William Lucas
-had been formerly in trade in Meryton, where he had made a
-tolerable fortune, and risen to the honour of knighthood by an
-address to the king during his mayoralty.  The distinction had
-perhaps been felt too strongly.  It had given him a disgust
-to his business, and to his residence in a small market town;
-and, in quitting them both, he had removed with his family
-to a house about a mile from Meryton, denominated from that
-period Lucas Lodge, where he could think with pleasure of his
-own importance, and, unshackled by business, occupy himself
-solely in being civil to all the world.  For, though elated by his
-rank, it did not render him supercilious; on the contrary, he was
-all attention to everybody.  By nature inoffensive, friendly, and
-obliging, his presentation at St. James's had made him courteous.
-
-Lady Lucas was a very good kind of woman, not too clever to
-be a valuable neighbour to Mrs. Bennet.  They had several
-children.  The eldest of them, a sensible, intelligent young
-woman, about twenty-seven, was Elizabeth's intimate friend.
-
-That the Miss Lucases and the Miss Bennets should meet to
-talk over a ball was absolutely necessary; and the morning after
-the assembly brought the former to Longbourn to hear and to
-communicate.
-
-"YOU began the evening well, Charlotte," said Mrs. Bennet with
-civil self-command to Miss Lucas.  "YOU were Mr. Bingley's
-first choice."
-
-"Yes; but he seemed to like his second better."
-
-"Oh! you mean Jane, I suppose, because he danced with her
-twice.  To be sure that DID seem as if he admired her--indeed
-I rather believe he DID--I heard something about it--but I
-hardly know what--something about Mr. Robinson."
-
-"Perhaps you mean what I overheard between him and Mr. Robinson;
-did not I mention it to you?  Mr. Robinson's asking him how he
-liked our Meryton assemblies, and whether he did not think there
-were a great many pretty women in the room, and WHICH he thought
-the prettiest? and his answering immediately to the last
-question: 'Oh! the eldest Miss Bennet, beyond a doubt; there
-cannot be two opinions on that point.'"
-
-"Upon my word!  Well, that is very decided indeed--that does
-seem as if--but, however, it may all come to nothing, you know."
-
-"MY overhearings were more to the purpose than YOURS, Eliza,"
-said Charlotte.  "Mr. Darcy is not so well worth listening to
-as his friend, is he?--poor Eliza!--to be only just TOLERABLE."
-
-"I beg you would not put it into Lizzy's head to be vexed by
-his ill-treatment, for he is such a disagreeable man, that it
-would be quite a misfortune to be liked by him.  Mrs. Long
-told me last night that he sat close to her for half-an-hour
-without once opening his lips."
-
-"Are you quite sure, ma'am?--is not there a little mistake?"
-said Jane.  "I certainly saw Mr. Darcy speaking to her."
-
-"Aye--because she asked him at last how he liked Netherfield,
-and he could not help answering her; but she said he seemed
-quite angry at being spoke to."
-
-"Miss Bingley told me," said Jane, "that he never speaks much,
-unless among his intimate acquaintances.  With THEM he is
-remarkably agreeable."
-
-"I do not believe a word of it, my dear.  If he had been so very
-agreeable, he would have talked to Mrs. Long.  But I can guess
-how it was; everybody says that he is eat up with pride, and I
-dare say he had heard somehow that Mrs. Long does not keep
-a carriage, and had come to the ball in a hack chaise."
-
-"I do not mind his not talking to Mrs. Long," said Miss Lucas,
-"but I wish he had danced with Eliza."
-
-"Another time, Lizzy," said her mother, "I would not dance
-with HIM, if I were you."
-
-"I believe, ma'am, I may safely promise you NEVER to dance
-with him."
-
-"His pride," said Miss Lucas, "does not offend ME so much as
-pride often does, because there is an excuse for it.  One cannot
-wonder that so very fine a young man, with family, fortune,
-everything in his favour, should think highly of himself.  If I
-may so express it, he has a RIGHT to be proud."
-
-"That is very true," replied Elizabeth, "and I could easily
-forgive HIS pride, if he had not mortified MINE."
-
-"Pride," observed Mary, who piqued herself upon the solidity
-of her reflections, "is a very common failing, I believe.  By
-all that I have ever read, I am convinced that it is very common
-indeed; that human nature is particularly prone to it, and
-that there are very few of us who do not cherish a feeling of
-self-complacency on the score of some quality or other, real
-or imaginary.  Vanity and pride are different things, though
-the words are often used synonymously.  A person may be proud
-without being vain.  Pride relates more to our opinion of
-ourselves, vanity to what we would have others think of us."
-
-"If I were as rich as Mr. Darcy," cried a young Lucas, who
-came with his sisters, "I should not care how proud I was.  I
-would keep a pack of foxhounds, and drink a bottle of wine a
-day."
-
-"Then you would drink a great deal more than you ought," said
-Mrs. Bennet; "and if I were to see you at it, I should take away
-your bottle directly."
-
-The boy protested that she should not; she continued to declare
-that she would, and the argument ended only with the visit.
-
-
-
-Chapter 6
-
-
-The ladies of Longbourn soon waited on those of Netherfield.
-The visit was soon returned in due form.  Miss Bennet's
-pleasing manners grew on the goodwill of Mrs. Hurst and Miss
-Bingley; and though the mother was found to be intolerable,
-and the younger sisters not worth speaking to, a wish of
-being better acquainted with THEM was expressed towards
-the two eldest.  By Jane, this attention was received with the
-greatest pleasure, but Elizabeth still saw superciliousness in
-their treatment of everybody, hardly excepting even her sister,
-and could not like them; though their kindness to Jane, such as it
-was, had a value as arising in all probability from the influence
-of their brother's admiration.  It was generally evident
-whenever they met, that he DID admire her and to HER it was
-equally evident that Jane was yielding to the preference which
-she had begun to entertain for him from the first, and was in a
-way to be very much in love; but she considered with pleasure
-that it was not likely to be discovered by the world in general,
-since Jane united, with great strength of feeling, a composure
-of temper and a uniform cheerfulness of manner which would
-guard her from the suspicions of the impertinent.  She
-mentioned this to her friend Miss Lucas.
-
-"It may perhaps be pleasant," replied Charlotte, "to be able to
-impose on the public in such a case; but it is sometimes a
-disadvantage to be so very guarded.  If a woman conceals her
-affection with the same skill from the object of it, she may lose
-the opportunity of fixing him; and it will then be but poor
-consolation to believe the world equally in the dark.  There is
-so much of gratitude or vanity in almost every attachment, that
-it is not safe to leave any to itself.  We can all BEGIN freely--a
-slight preference is natural enough; but there are very few of us
-who have heart enough to be really in love without encouragement.
-In nine cases out of ten a women had better show MORE affection
-than she feels.  Bingley likes your sister undoubtedly; but he
-may never do more than like her, if she does not help him on."
-
-"But she does help him on, as much as her nature will allow.
-If I can perceive her regard for him, he must be a simpleton,
-indeed, not to discover it too."
-
-"Remember, Eliza, that he does not know Jane's disposition as
-you do."
-
-"But if a woman is partial to a man, and does not endeavour to
-conceal it, he must find it out."
-
-"Perhaps he must, if he sees enough of her.  But, though
-Bingley and Jane meet tolerably often, it is never for many
-hours together; and, as they always see each other in large
-mixed parties, it is impossible that every moment should be
-employed in conversing together.  Jane should therefore make
-the most of every half-hour in which she can command his
-attention.  When she is secure of him, there will be more leisure
-for falling in love as much as she chooses."
-
-"Your plan is a good one," replied Elizabeth, "where nothing is
-in question but the desire of being well married, and if I were
-determined to get a rich husband, or any husband, I dare say I
-should adopt it.  But these are not Jane's feelings; she is not
-acting by design.  As yet, she cannot even be certain of the
-degree of her own regard nor of its reasonableness.  She has
-known him only a fortnight.  She danced four dances with him
-at Meryton; she saw him one morning at his own house, and
-has since dined with him in company four times.  This is not
-quite enough to make her understand his character."
-
-"Not as you represent it.  Had she merely DINED with him, she
-might only have discovered whether he had a good appetite; but
-you must remember that four evenings have also been spent
-together--and four evenings may do a great deal."
-
-"Yes; these four evenings have enabled them to ascertain that
-they both like Vingt-un better than Commerce; but with respect
-to any other leading characteristic, I do not imagine that much
-has been unfolded."
-
-"Well," said Charlotte, "I wish Jane success with all my heart;
-and if she were married to him to-morrow, I should think she
-had as good a chance of happiness as if she were to be studying
-his character for a twelvemonth.  Happiness in marriage is
-entirely  a matter of chance.  If the dispositions of the parties
-are ever so well known to each other or ever so similar beforehand,
-it does not advance their felicity in the least.  They always
-continue to grow sufficiently unlike afterwards to have their
-share of vexation; and it is better to know as little as possible
-of the defects of the person with whom you are to pass your life."
-
-"You make me laugh, Charlotte; but it is not sound.  You know
-it is not sound, and that you would never act in this way
-yourself."
-
-Occupied in observing Mr. Bingley's attentions to her sister,
-Elizabeth was far from suspecting that she was herself becoming
-an object of some interest in the eyes of his friend.  Mr. Darcy
-had at first scarcely allowed her to be pretty; he had looked at
-her without admiration at the ball; and when they next met, he
-looked at her only to criticise.  But no sooner had he made it
-clear to himself and his friends that she hardly had a good feature
-in her face, than he began to find it was rendered uncommonly
-intelligent by the beautiful expression of her dark eyes.  To this
-discovery succeeded some others equally mortifying.  Though he
-had detected with a critical eye more than one failure of perfect
-symmetry in her form, he was forced to acknowledge her figure
-to be light and pleasing; and in spite of his asserting that her
-manners were not those of the fashionable world, he was caught
-by their easy playfulness.  Of this she was perfectly unaware;
-to her he was only the man who made himself agreeable nowhere,
-and who had not thought her handsome enough to dance with.
-
-He began to wish to know more of her, and as a step towards
-conversing with her himself, attended to her conversation with
-others.  His doing so drew her notice.  It was at Sir William
-Lucas's, where a large party were assembled.
-
-"What does Mr. Darcy mean," said she to Charlotte, "by
-listening to my conversation with Colonel Forster?"
-
-"That is a question which Mr. Darcy only can answer."
-
-"But if he does it any more I shall certainly let him know that I
-see what he is about.  He has a very satirical eye, and if I do not
-begin by being impertinent myself, I shall soon grow afraid of
-him."
-
-On his approaching them soon afterwards, though without
-seeming to have any intention of speaking, Miss Lucas defied
-her friend to mention such a subject to him; which immediately
-provoking Elizabeth to do it, she turned to him and said:
-
-"Did you not think, Mr. Darcy, that I expressed myself
-uncommonly well just now, when I was teasing Colonel Forster
-to give us a ball at Meryton?"
-
-"With great energy; but it is always a subject which makes a lady
-energetic."
-
-"You are severe on us."
-
-"It will be HER turn soon to be teased," said Miss Lucas.  "I
-am going to open the instrument, Eliza, and you know what
-follows."
-
-"You are a very strange creature by way of a friend!--always
-wanting me to play and sing before anybody and everybody!
-If my vanity had taken a musical turn, you would have been
-invaluable; but as it is, I would really rather not sit down
-before those who must be in the habit of hearing the very best
-performers."  On Miss Lucas's persevering, however, she added,
-"Very well, if it must be so, it must."  And gravely glancing at
-Mr. Darcy, "There is a fine old saying, which everybody here is of
-course familiar with: 'Keep your breath to cool your porridge';
-and I shall keep mine to swell my song."
-
-Her performance was pleasing, though by no means capital.
-After a song or two, and before she could reply to the entreaties
-of several that she would sing again, she was eagerly succeeded
-at the instrument by her sister Mary, who having, in consequence
-of being the only plain one in the family, worked hard for
-knowledge and accomplishments, was always impatient for
-display.
-
-Mary had neither genius nor taste; and though vanity had given
-her application, it had given her likewise a pedantic air and
-conceited manner, which would have injured a higher degree of
-excellence than she had reached.  Elizabeth, easy and unaffected,
-had been listened to with much more pleasure, though not
-playing half so well; and Mary, at the end of a long concerto,
-was glad to purchase praise and gratitude by Scotch and Irish
-airs, at the request of her younger sisters, who, with some of the
-Lucases, and two or three officers, joined eagerly in dancing at
-one end of the room.
-
-Mr. Darcy stood near them in silent indignation at such a mode
-of passing the evening, to the exclusion of all conversation, and
-was too much engrossed by his thoughts to perceive that Sir
-William Lucas was his neighbour, till Sir William thus began:
-
-"What a charming amusement for young people this is, Mr. Darcy!
-There is nothing like dancing after all.  I consider it as one
-of the first refinements of polished society."
-
-"Certainly, sir; and it has the advantage also of being in vogue
-amongst the less polished societies of the world.  Every savage
-can dance."
-
-Sir William only smiled.  "Your friend performs delightfully," he
-continued after a pause, on seeing Bingley join the group; "and I
-doubt not that you are an adept in the science yourself, Mr.
-Darcy."
-
-"You saw me dance at Meryton, I believe, sir."
-
-"Yes, indeed, and received no inconsiderable pleasure from the
-sight.  Do you often dance at St. James's?"
-
-"Never, sir."
-
-"Do you not think it would be a proper compliment to the
-place?"
-
-"It is a compliment which I never pay to any place if I can
-avoid it."
-
-"You have a house in town, I conclude?"
-
-Mr. Darcy bowed.
-
-"I had once had some thought of fixing in town myself--for I am
-fond of superior society; but I did not feel quite certain that the
-air of London would agree with Lady Lucas."
-
-He paused in hopes of an answer; but his companion was not
-disposed to make any; and Elizabeth at that instant moving
-towards them, he was struck with the action of doing a very
-gallant thing, and called out to her:
-
-"My dear Miss Eliza, why are you not dancing?  Mr. Darcy, you
-must allow me to present this young lady to you as a very
-desirable partner.  You cannot refuse to dance, I am sure when
-so much beauty is before you."  And, taking her hand, he would
-have given it to Mr. Darcy who, though extremely surprised,
-was not unwilling to receive it, when she instantly drew back,
-and said with some discomposure to Sir William:
-
-"Indeed, sir, I have not the least intention of dancing.  I entreat
-you not to suppose that I moved this way in order to beg for a
-partner."
-
-Mr. Darcy, with grave propriety, requested to be allowed the
-honour of her hand, but in vain.  Elizabeth was determined; nor
-did Sir William at all shake her purpose by his attempt at
-persuasion.
-
-"You excel so much in the dance, Miss Eliza, that it is cruel to
-deny me the happiness of seeing you; and though this gentleman
-dislikes the amusement in general, he can have no objection, I
-am sure, to oblige us for one half-hour."
-
-"Mr. Darcy is all politeness," said Elizabeth, smiling.
-
-"He is, indeed; but, considering the inducement, my dear Miss
-Eliza, we cannot wonder at his complaisance--for who would
-object to such a partner?"
-
-Elizabeth looked archly, and turned away.  Her resistance had
-not injured her with the gentleman, and he was thinking of her
-with some complacency, when thus accosted by Miss Bingley:
-
-"I can guess the subject of your reverie."
-
-"I should imagine not."
-
-"You are considering how insupportable it would be to pass many
-evenings in this manner--in such society; and indeed I am quite
-of your opinion.  I was never more annoyed!  The insipidity, and
-yet the noise--the nothingness, and yet the self-importance of all
-those people!  What would I give to hear your strictures on them!"
-
-"You conjecture is totally wrong, I assure you.  My mind was
-more agreeably engaged.  I have been meditating on the very
-great pleasure which a pair of fine eyes in the face of a pretty
-woman can bestow."
-
-Miss Bingley immediately fixed her eyes on his face, and desired
-he would tell her what lady had the credit of inspiring such
-reflections.  Mr. Darcy replied with great intrepidity:
-
-"Miss Elizabeth Bennet."
-
-"Miss Elizabeth Bennet!" repeated Miss Bingley.  "I am all
-astonishment.  How long has she been such a favourite?--and
-pray, when am I to wish you joy?"
-
-"That is exactly the question which I expected you to ask.  A
-lady's imagination is very rapid; it jumps from admiration to
-love, from love to matrimony, in a moment.  I knew you would
-be wishing me joy."
-
-"Nay, if you are serious about it, I shall consider the matter is
-absolutely settled.  You will be having a charming mother-in-law,
-indeed; and, of course, she will always be at Pemberley with you."
-
-He listened to her with perfect indifference while she chose to
-entertain herself in this manner; and as his composure convinced
-her that all was safe, her wit flowed long.
-
-
-
-Chapter 7
-
-
-Mr. Bennet's property consisted almost entirely in an estate of
-two thousand a year, which, unfortunately for his daughters, was
-entailed, in default of heirs male, on a distant relation; and their
-mother's fortune, though ample for her situation in life, could
-but ill supply the deficiency of his.  Her father had been an
-attorney in Meryton, and had left her four thousand pounds.
-
-She had a sister married to a Mr. Phillips, who had been a clerk
-to their father and succeeded him in the business, and a brother
-settled in London in a respectable line of trade.
-
-The village of Longbourn was only one mile from Meryton; a
-most convenient distance for the young ladies, who were usually
-tempted thither three or four times a week, to pay their duty to
-their aunt and to a milliner's shop just over the way.  The two
-youngest of the family, Catherine and Lydia, were particularly
-frequent in these attentions; their minds were more vacant than
-their sisters', and when nothing better offered, a walk to
-Meryton was necessary to amuse their morning hours and
-furnish conversation for the evening; and however bare of news
-the country in general might be, they always contrived to learn
-some from their aunt.  At present, indeed, they were well
-supplied both with news and happiness by the recent arrival of
-a militia regiment in the neighbourhood; it was to remain the
-whole winter, and Meryton was the headquarters.
-
-Their visits to Mrs. Phillips were now productive of the most
-interesting intelligence.  Every day added something to their
-knowledge of the officers' names and connections.  Their
-lodgings were not long a secret, and at length they began to
-know the officers themselves.  Mr. Phillips visited them all, and
-this opened to his nieces a store of felicity unknown before.
-They could talk of nothing but officers; and Mr. Bingley's large
-fortune, the mention of which gave animation to their mother,
-was worthless in their eyes when opposed to the regimentals of
-an ensign.
-
-After listening one morning to their effusions on this subject, Mr.
-Bennet coolly observed:
-
-"From all that I can collect by your manner of talking, you must
-be two of the silliest girls in the country.  I have suspected it
-some time, but I am now convinced."
-
-Catherine was disconcerted, and made no answer; but Lydia,
-with perfect indifference, continued to express her admiration of
-Captain Carter, and her hope of seeing him in the course of the
-day, as he was going the next morning to London.
-
-"I am astonished, my dear," said Mrs. Bennet, "that you should
-be so ready to think your own children silly.  If I wished to think
-slightingly of anybody's children, it should not be of my own,
-however."
-
-"If my children are silly, I must hope to be always sensible of it."
-
-"Yes--but as it happens, they are all of them very clever."
-
-"This is the only point, I flatter myself, on which we do not
-agree.  I had hoped that our sentiments coincided in every
-particular, but I must so far differ from you as to think our two
-youngest daughters uncommonly foolish."
-
-"My dear Mr. Bennet, you must not expect such girls to have
-the sense of their father and mother.  When they get to our age, I
-dare say they will not think about officers any more than we do.
-I remember the time when I liked a red coat myself very well--and,
-indeed, so I do still at my heart; and if a smart young colonel,
-with five or six thousand a year, should want one of my girls I
-shall not say nay to him; and I thought Colonel Forster looked
-very becoming the other night at Sir William's in his regimentals."
-
-"Mamma," cried Lydia, "my aunt says that Colonel Forster and
-Captain Carter do not go so often to Miss Watson's as they did
-when they first came; she sees them now very often standing in
-Clarke's library."
-
-Mrs. Bennet was prevented replying by the entrance of the
-footman with a note for Miss Bennet; it came from Netherfield,
-and the servant waited for an answer.  Mrs. Bennet's eyes
-sparkled with pleasure, and she was eagerly calling out, while
-her daughter read,
-
-"Well, Jane, who is it from?  What is it about?  What does he
-say?  Well, Jane, make haste and tell us; make haste, my love."
-
-"It is from Miss Bingley," said Jane, and then read it aloud.
-
-"MY DEAR FRIEND,--
-
-"If you are not so compassionate as to dine to-day with Louisa
-and me, we shall be in danger of hating each other for the rest
-of our lives, for a whole day's tete-a-tete between two women
-can never end without a quarrel.  Come as soon as you can on
-receipt of this.  My brother and the gentlemen are to dine with
-the officers.--Yours ever,
-
-"CAROLINE BINGLEY"
-
-"With the officers!" cried Lydia.  "I wonder my aunt did not tell
-us of THAT."
-
-"Dining out," said Mrs. Bennet, "that is very unlucky."
-
-"Can I have the carriage?" said Jane.
-
-"No, my dear, you had better go on horseback, because it seems
-likely to rain; and then you must stay all night."
-
-"That would be a good scheme," said Elizabeth, "if you were
-sure that they would not offer to send her home."
-
-"Oh! but the gentlemen will have Mr. Bingley's chaise to go to
-Meryton, and the Hursts have no horses to theirs."
-
-"I had much rather go in the coach."
-
-"But, my dear, your father cannot spare the horses, I am sure.
-They are wanted in the farm, Mr. Bennet, are they not?"
-
-"They are wanted in the farm much oftener than I can get them."
-
-"But if you have got them to-day," said Elizabeth, "my mother's
-purpose will be answered."
-
-She did at last extort from her father an acknowledgment that
-the horses were engaged.  Jane was therefore obliged to go on
-horseback, and her mother attended her to the door with many
-cheerful prognostics of a bad day.  Her hopes were answered;
-Jane had not been gone long before it rained hard.  Her sisters
-were uneasy for her, but her mother was delighted.  The rain
-continued the whole evening without intermission; Jane certainly
-could not come back.
-
-"This was a lucky idea of mine, indeed!" said Mrs. Bennet more
-than once, as if the credit of making it rain were all her own.  Till
-the next morning, however, she was not aware of all the felicity
-of her contrivance.  Breakfast was scarcely over when a servant
-from Netherfield brought the following note for Elizabeth:
-
-"MY DEAREST LIZZY,--
-
-"I find myself very unwell this morning, which, I suppose, is to
-be imputed to my getting wet through yesterday.  My kind friends
-will not hear of my returning till I am better.  They insist also
-on my seeing Mr. Jones--therefore do not be alarmed if you should
-hear of his having been to me--and, excepting a sore throat and
-headache, there is not much the matter with me.--Yours, etc."
-
-"Well, my dear," said Mr. Bennet, when Elizabeth had read the
-note aloud, "if your daughter should have a dangerous fit of
-illness--if she should die, it would be a comfort to know that it
-was all in pursuit of Mr. Bingley, and under your orders."
-
-"Oh! I am not afraid of her dying.  People do not die of little
-trifling colds.  She will be taken good care of.  As long as she
-stays there, it is all very well.  I would go an see her if I could
-have the carriage."
-
-Elizabeth, feeling really anxious, was determined to go to her,
-though the carriage was not to be had; and as she was no
-horsewoman, walking was her only alternative.  She declared her
-resolution.
-
-"How can you be so silly," cried her mother, "as to think of such
-a thing, in all this dirt!  You will not be fit to be seen when you
-get there."
-
-"I shall be very fit to see Jane--which is all I want."
-
-"Is this a hint to me, Lizzy," said her father, "to send for
-the horses?"
-
-"No, indeed, I do not wish to avoid the walk.  The distance is
-nothing when one has a motive; only three miles.  I shall be back
-by dinner."
-
-"I admire the activity of your benevolence," observed Mary, "but
-every impulse of feeling should be guided by reason; and, in my
-opinion, exertion should always be in proportion to what is
-required."
-
-"We will go as far as Meryton with you," said Catherine and
-Lydia.  Elizabeth accepted their company, and the three young
-ladies set off together.
-
-"If we make haste," said Lydia, as they walked along, "perhaps
-we may see something of Captain Carter before he goes."
-
-In Meryton they parted; the two youngest repaired to the lodgings of
-one of the officers' wives, and Elizabeth continued her walk alone,
-crossing field after field at a quick pace, jumping over stiles
-and springing over puddles with impatient activity, and finding
-herself at last within view of the house, with weary ankles, dirty
-stockings, and a face glowing with the warmth of exercise.
-
-She was shown into the breakfast-parlour, where all but Jane
-were assembled, and where her appearance created a great deal
-of surprise.  That she should have walked three miles so early
-in the day, in such dirty weather, and by herself, was almost
-incredible to Mrs. Hurst and Miss Bingley; and Elizabeth was
-convinced that they held her in contempt for it.  She was
-received, however, very politely by them; and in their brother's
-manners there was something better than politeness; there was
-good humour and kindness.  Mr. Darcy said very little, and Mr.
-Hurst nothing at all.  The former was divided between admiration
-of the brilliancy which exercise had given to her complexion,
-and doubt as to the occasion's justifying her coming so far
-alone.  The latter was thinking only of his breakfast.
-
-Her inquiries after her sister were not very favourably answered.
-Miss Bennet had slept ill, and though up, was very feverish, and
-not well enough to leave her room.  Elizabeth was glad to be
-taken to her immediately; and Jane, who had only been withheld
-by the fear of giving alarm or inconvenience from expressing in
-her note how much she longed for such a visit, was delighted at
-her entrance.  She was not equal, however, to much conversation,
-and when Miss Bingley left them together, could attempt little
-besides expressions of gratitude for the extraordinary kindness
-she was treated with.  Elizabeth silently attended her.
-
-When breakfast was over they were joined by the sisters; and
-Elizabeth began to like them herself, when she saw how much
-affection and solicitude they showed for Jane.  The apothecary
-came, and having examined his patient, said, as might be
-supposed, that she had caught a violent cold, and that they must
-endeavour to get the better of it; advised her to return to bed,
-and promised her some draughts.  The advice was followed
-readily, for the feverish symptoms increased, and her head ached
-acutely.  Elizabeth did not quit her room for a moment; nor were
-the other ladies often absent; the gentlemen being out, they had,
-in fact, nothing to do elsewhere.
-
-When the clock struck three, Elizabeth felt that she must go, and
-very unwillingly said so.  Miss Bingley offered her the carriage,
-and she only wanted a little pressing to accept it, when Jane
-testified such concern in parting with her, that Miss Bingley was
-obliged to convert the offer of the chaise to an invitation to
-remain at Netherfield for the present.  Elizabeth most thankfully
-consented, and a servant was dispatched to Longbourn to
-acquaint the family with her stay and bring back a supply of
-clothes.
-
-
-
-Chapter 8
-
-
-At five o'clock the two ladies retired to dress, and at half-past
-six Elizabeth was summoned to dinner.  To the civil inquiries
-which then poured in, and amongst which she had the pleasure
-of distinguishing the much superior solicitude of Mr. Bingley's,
-she could not make a very favourable answer.  Jane was by no
-means better.  The sisters, on hearing this, repeated three or four
-times how much they were grieved, how shocking it was to have
-a bad cold, and how excessively they disliked being ill
-themselves; and then thought no more of the matter: and their
-indifference towards Jane when not immediately before them
-restored Elizabeth to the enjoyment of all her former dislike.
-
-Their brother, indeed, was the only one of the party whom she
-could regard with any complacency.  His anxiety for Jane was
-evident, and his attentions to herself most pleasing, and
-they prevented her feeling herself so much an intruder as she
-believed she was considered by the others.  She had very little
-notice from any but him.  Miss Bingley was engrossed by Mr.
-Darcy, her sister scarcely less so; and as for Mr. Hurst, by
-whom Elizabeth sat, he was an indolent man, who lived only to
-eat, drink, and play at cards; who, when he found her to prefer
-a plain dish to a ragout, had nothing to say to her.
-
-When dinner was over, she returned directly to Jane, and Miss
-Bingley began abusing her as soon as she was out of the room.
-Her manners were pronounced to be very bad indeed, a mixture
-of pride and impertinence; she had no conversation, no style, no
-beauty.  Mrs. Hurst thought the same, and added:
-
-"She has nothing, in short, to recommend her, but being an
-excellent walker.  I shall never forget her appearance this
-morning.  She really looked almost wild."
-
-"She did, indeed, Louisa.  I could hardly keep my countenance.
-Very nonsensical to come at all!  Why must SHE be scampering
-about the country, because her sister had a cold?  Her hair, so
-untidy, so blowsy!"
-
-"Yes, and her petticoat; I hope you saw her petticoat, six inches
-deep in mud, I am absolutely certain; and the gown which had
-been let down to hide it not doing its office."
-
-"Your picture may be very exact, Louisa," said Bingley; "but
-this was all lost upon me.  I thought Miss Elizabeth Bennet
-looked remarkably well when she came into the room this
-morning.  Her dirty petticoat quite escaped my notice."
-
-"YOU observed it, Mr. Darcy, I am sure," said Miss Bingley;
-"and I am inclined to think that you would not wish to see
-YOUR sister make such an exhibition."
-
-"Certainly not."
-
-"To walk three miles, or four miles, or five miles, or whatever it
-is, above her ankles in dirt, and alone, quite alone!  What could
-she mean by it?  It seems to me to show an abominable sort of
-conceited independence, a most country-town indifference to
-decorum."
-
-"It shows an affection for her sister that is very pleasing," said
-Bingley.
-
-"I am afraid, Mr. Darcy," observed Miss Bingley in a half
-whisper, "that this adventure has rather affected your
-admiration of her fine eyes."
-
-"Not at all," he replied; "they were brightened by the exercise."
-A short pause followed this speech, and Mrs. Hurst began again:
-
-"I have a excessive regard for Miss Jane Bennet, she is really
-a very sweet girl, and I wish with all my heart she were well
-settled.  But with such a father and mother, and such low
-connections, I am afraid there is no chance of it."
-
-"I think I have heard you say that their uncle is an attorney on
-Meryton."
-
-"Yes; and they have another, who lives somewhere near Cheapside."
-
-"That is capital," added her sister, and they both laughed heartily.
-
-"If they had uncles enough to fill ALL Cheapside," cried
-Bingley, "it would not make them one jot less agreeable."
-
-"But it must very materially lessen their chance of marrying men
-of any consideration in the world," replied Darcy.
-
-To this speech Bingley made no answer; but his sisters gave it
-their hearty assent, and indulged their mirth for some time at the
-expense of their dear friend's vulgar relations.
-
-With a renewal of tenderness, however, they returned to her
-room on leaving the dining-parlour, and sat with her till
-summoned to coffee.  She was still very poorly, and Elizabeth
-would not quit her at all, till late in the evening, when she had
-the comfort of seeing her sleep, and when it seemed to her rather
-right than pleasant that she should go downstairs herself.  On
-entering the drawing-room she found the whole party at loo, and
-was immediately invited to join them; but suspecting them to be
-playing high she declined it, and making her sister the excuse,
-said she would amuse herself for the short time she could stay
-below, with a book.  Mr. Hurst looked at her with astonishment.
-
-"Do you prefer reading to cards?" said he; "that is rather
-singular."
-
-"Miss Eliza Bennet," said Miss Bingley, "despises cards.  She is
-a great reader, and has no pleasure in anything else."
-
-"I deserve neither such praise nor such censure," cried Elizabeth;
-"I am NOT a great reader, and I have pleasure in many things."
-
-"In nursing your sister I am sure you have pleasure," said Bingley;
-"and I hope it will be soon increased by seeing her quite well."
-
-Elizabeth thanked him from her heart, and then walked towards
-the table where a few books were lying.  He immediately offered
-to fetch her others--all that his library afforded.
-
-"And I wish my collection were larger for your benefit and my
-own credit; but I am an idle fellow, and though I have not many,
-I have more than I ever looked into."
-
-Elizabeth assured him that she could suit herself perfectly with
-those in the room.
-
-"I am astonished," said Miss Bingley, "that my father should
-have left so small a collection of books.  What a delightful library
-you have at Pemberley, Mr. Darcy!"
-
-"It ought to be good," he replied, "it has been the work of many
-generations."
-
-"And then you have added so much to it yourself, you are
-always buying books."
-
-"I cannot comprehend the neglect of a family library in such days
-as these."
-
-"Neglect!  I am sure you neglect nothing that can add to the
-beauties of that noble place.  Charles, when you build YOUR
-house, I wish it may be half as delightful as Pemberley."
-
-"I wish it may."
-
-"But I would really advise you to make your purchase in that
-neighbourhood, and take Pemberley for a kind of model.  There
-is not a finer county in England than Derbyshire."
-
-"With all my heart; I will buy Pemberley itself if Darcy will
-sell it."
-
-"I am talking of possibilities, Charles."
-
-"Upon my word, Caroline, I should think it more possible to get
-Pemberley by purchase than by imitation."
-
-Elizabeth was so much caught with what passed, as to leave her
-very little attention for her book; and soon laying it wholly
-aside, she drew near the card-table, and stationed herself
-between Mr. Bingley and his eldest sister, to observe the game.
-
-"Is Miss Darcy much grown since the spring?" said Miss
-Bingley; "will she be as tall as I am?"
-
-"I think she will.  She is now about Miss Elizabeth Bennet's
-height, or rather taller."
-
-"How I long to see her again!  I never met with anybody who
-delighted me so much.  Such a countenance, such manners!  And
-so extremely accomplished for her age!  Her performance on the
-pianoforte is exquisite."
-
-"It is amazing to me," said Bingley, "how young ladies can have
-patience to be so very accomplished as they all are."
-
-"All young ladies accomplished!  My dear Charles, what do you mean?"
-
-"Yes, all of them, I think.  They all paint tables, cover screens,
-and net purses.  I scarcely know anyone who cannot do all this,
-and I am sure I never heard a young lady spoken of for the first
-time, without being informed that she was very accomplished."
-
-"Your list of the common extent of accomplishments," said Darcy,
-"has too much truth.  The word is applied to many a woman who
-deserves it no otherwise than by netting a purse or covering
-a screen.  But I am very far from agreeing with you in your
-estimation of ladies in general.  I cannot boast of knowing
-more than half-a-dozen, in the whole range of my acquaintance,
-that are really accomplished."
-
-"Nor I, I am sure," said Miss Bingley.
-
-"Then," observed Elizabeth, "you must comprehend a great deal
-in your idea of an accomplished woman."
-
-"Yes, I do comprehend a great deal in it."
-
-"Oh! certainly," cried his faithful assistant, "no one can be really
-esteemed accomplished who does not greatly surpass what is
-usually met with.  A woman must have a thorough knowledge of
-music, singing, drawing, dancing, and the modern languages, to
-deserve the word; and besides all this, she must possess a certain
-something in her air and manner of walking, the tone of her
-voice, her address and expressions, or the word will be but
-half-deserved."
-
-"All this she must possess," added Darcy, "and to all this she
-must yet add something more substantial, in the improvement of
-her mind by extensive reading."
-
-"I am no longer surprised at your knowing ONLY six accomplished
-women.  I rather wonder now at your knowing ANY."
-
-"Are you so severe upon your own sex as to doubt the possibility
-of all this?"
-
-"I never saw such a woman.  I never saw such capacity, and
-taste, and application, and elegance, as you describe united."
-
-Mrs. Hurst and Miss Bingley both cried out against the injustice
-of her implied doubt, and were both protesting that they knew
-many women who answered this description, when Mr. Hurst
-called them to order, with bitter complaints of their inattention
-to what was going forward.  As all conversation was thereby at
-an end, Elizabeth soon afterwards left the room.
-
-"Elizabeth Bennet," said Miss Bingley, when the door was
-closed on her, "is one of those young ladies who seek to
-recommend themselves to the other sex by undervaluing their
-own; and with many men, I dare say, it succeeds.  But, in my
-opinion, it is a paltry device, a very mean art."
-
-"Undoubtedly," replied Darcy, to whom this remark was chiefly
-addressed, "there is a meanness in ALL the arts which ladies
-sometimes condescend to employ for captivation.  Whatever
-bears affinity to cunning is despicable."
-
-Miss Bingley was not so entirely satisfied with this reply as to
-continue the subject.
-
-Elizabeth joined them again only to say that her sister was worse,
-and that she could not leave her.  Bingley urged Mr. Jones being
-sent for immediately; while his sisters, convinced that no country
-advice could be of any service, recommended an express to town for
-one of the most eminent physicians.  This she would not hear of;
-but she was not so unwilling to comply with their brother's
-proposal; and it was settled that Mr. Jones should be sent for
-early in the morning, if Miss Bennet were not decidedly better.
-Bingley was quite uncomfortable; his sisters declared that they
-were miserable.  They solaced their wretchedness, however, by
-duets after supper, while he could find no better relief to his
-feelings than by giving his housekeeper directions that every
-attention might be paid to the sick lady and her sister.
-
-
-
-Chapter 9
-
-
-Elizabeth passed the chief of the night in her sister's room, and
-in the morning had the pleasure of being able to send a tolerable
-answer to the inquiries which she very early received from Mr.
-Bingley by a housemaid, and some time afterwards from the two
-elegant ladies who waited on his sisters.  In spite of this
-amendment, however, she requested to have a note sent to Longbourn,
-desiring her mother to visit Jane, and form her own judgement of
-her situation.  The note was immediately dispatched, and its
-contents as quickly complied with.  Mrs. Bennet, accompanied by
-her two youngest girls, reached Netherfield soon after the family
-breakfast.
-
-Had she found Jane in any apparent danger, Mrs. Bennet would
-have been very miserable; but being satisfied on seeing her that
-her illness was not alarming, she had no wish of her recovering
-immediately, as her restoration to health would probably remove
-her from Netherfield.  She would not listen, therefore, to her
-daughter's proposal of being carried home; neither did the
-apothecary, who arrived about the same time, think it at all
-advisable.  After sitting a little while with Jane, on Miss
-Bingley's appearance and invitation, the mother and three
-daughter all attended her into the breakfast parlour.  Bingley met
-them with hopes that Mrs. Bennet had not found Miss Bennet
-worse than she expected.
-
-"Indeed I have, sir," was her answer.  "She is a great deal too
-ill to be moved.  Mr. Jones says we must not think of moving her.
-We must trespass a little longer on your kindness."
-
-"Removed!" cried Bingley.  "It must not be thought of.  My
-sister, I am sure, will not hear of her removal."
-
-"You may depend upon it, Madam," said Miss Bingley, with cold
-civility, "that Miss Bennet will receive every possible attention
-while she remains with us."
-
-Mrs. Bennet was profuse in her acknowledgments.
-
-"I am sure," she added, "if it was not for such good friends I do
-not know what would become of her, for she is very ill indeed,
-and suffers a vast deal, though with the greatest patience in the
-world, which is always the way with her, for she has, without
-exception, the sweetest temper I have ever met with.  I often tell
-my other girls they are nothing to HER.  You have a sweet room
-here, Mr. Bingley, and a charming prospect over the gravel walk.
-I do not know a place in the country that is equal to Netherfield.
-You will not think of quitting it in a hurry, I hope, though you
-have but a short lease."
-
-"Whatever I do is done in a hurry," replied he; "and therefore if I
-should resolve to quit Netherfield, I should probably be off in
-five minutes.  At present, however, I consider myself as quite
-fixed here."
-
-"That is exactly what I should have supposed of you," said
-Elizabeth.
-
-"You begin to comprehend me, do you?" cried he, turning
-towards her.
-
-"Oh! yes--I understand you perfectly."
-
-"I wish I might take this for a compliment; but to be so easily
-seen through I am afraid is pitiful."
-
-"That is as it happens.  It does not follow that a deep, intricate
-character is more or less estimable than such a one as yours."
-
-"Lizzy," cried her mother, "remember where you are, and do not
-run on in the wild manner that you are suffered to do at home."
-
-"I did not know before," continued Bingley immediately, "that
-your were a studier of character.  It must be an amusing study."
-
-"Yes, but intricate characters are the MOST amusing.  They
-have at least that advantage."
-
-"The country," said Darcy, "can in general supply but a few
-subjects for such a study.  In a country neighbourhood you move
-in a very confined and unvarying society."
-
-"But people themselves alter so much, that there is something
-new to be observed in them for ever."
-
-"Yes, indeed," cried Mrs. Bennet, offended by his manner of
-mentioning a country neighbourhood.  "I assure you there is
-quite as much of THAT going on in the country as in town."
-
-Everybody was surprised, and Darcy, after looking at her for a
-moment, turned silently away.  Mrs. Bennet, who fancied she
-had gained a complete victory over him, continued her triumph.
-
-"I cannot see that London has any great advantage over the
-country, for my part, except the shops and public places.  The
-country is a vast deal pleasanter, is it not, Mr. Bingley?"
-
-"When I am in the country," he replied, "I never wish to leave it;
-and when I am in town it is pretty much the same.  They have
-each their advantages, and I can be equally happy in either."
-
-"Aye--that is because you have the right disposition.  But that
-gentleman," looking at Darcy, "seemed to think the country was
-nothing at all."
-
-"Indeed, Mamma, you are mistaken," said Elizabeth, blushing for
-her mother.  "You quite mistook Mr. Darcy.  He only meant that
-there was not such a variety of people to be met with in the
-country as in the town, which you must acknowledge to be
-true."
-
-"Certainly, my dear, nobody said there were; but as to not
-meeting with many people in this neighbourhood, I believe
-there are few neighbourhoods larger.  I know we dine with
-four-and-twenty families."
-
-Nothing but concern for Elizabeth could enable Bingley to keep
-his countenance.  His sister was less delicate, and directed her
-eyes towards Mr. Darcy with a very expressive smile.  Elizabeth,
-for the sake of saying something that might turn her mother's
-thoughts, now asked her if Charlotte Lucas had been at
-Longbourn since HER coming away.
-
-"Yes, she called yesterday with her father.  What an agreeable
-man Sir William is, Mr. Bingley, is not he?  So much the man of
-fashion!  So genteel and easy!  He had always something to say
-to everybody.  THAT is my idea of good breeding; and those
-persons who fancy themselves very important, and never open
-their mouths, quite mistake the matter."
-
-"Did Charlotte dine with you?"
-
-"No, she would go home.  I fancy she was wanted about the
-mince-pies.  For my part, Mr. Bingley, I always keep servants
-that can do their own work; MY daughters are brought up very
-differently.  But everybody is to judge for themselves, and the
-Lucases are a very good sort of girls, I assure you.  It is a pity
-they are not handsome!  Not that I think Charlotte so VERY
-plain--but then she is our particular friend."
-
-"She seems a very pleasant young woman."
-
-"Oh! dear, yes; but you must own she is very plain.  Lady Lucas
-herself has often said so, and envied me Jane's beauty.  I do not
-like to boast of my own child, but to be sure, Jane--one does
-not often see anybody better looking.  It is what everybody says.
-I do not trust my own partiality.  When she was only fifteen,
-there was a man at my brother Gardiner's in town so much in
-love with her that my sister-in-law was sure he would make her
-an offer before we came away.  But, however, he did not.
-Perhaps he thought her too young.  However, he wrote some
-verses on her, and very pretty they were."
-
-"And so ended his affection," said Elizabeth impatiently.  "There
-has been many a one, I fancy, overcome in the same way.  I
-wonder who first discovered the efficacy of poetry in driving
-away love!"
-
-"I have been used to consider poetry as the FOOD of love," said
-Darcy.
-
-"Of  a fine, stout, healthy love it may.  Everything nourishes
-what is strong already.  But if it be only a slight, thin sort of
-inclination, I am convinced that one good sonnet will starve it
-entirely away."
-
-Darcy only smiled; and the general pause which ensued made
-Elizabeth tremble lest her mother should be exposing herself
-again.  She longed to speak, but could think of nothing to say;
-and after a short silence Mrs. Bennet began repeating her thanks
-to Mr. Bingley for his kindness to Jane, with an apology for
-troubling him also with Lizzy.  Mr. Bingley was unaffectedly
-civil in his answer, and forced his younger sister to be civil
-also, and say what the occasion required.  She performed her
-part indeed without much graciousness, but Mrs. Bennet was
-satisfied, and soon afterwards ordered her carriage.  Upon this
-signal, the youngest of her daughters put herself forward.  The
-two girls had been whispering to each other during the whole
-visit, and the result of it was, that the youngest should tax
-Mr. Bingley with having promised on his first coming into the
-country to give a ball at Netherfield.
-
-Lydia was a stout, well-grown girl of fifteen, with a fine
-complexion and good-humoured countenance; a favourite with her
-mother, whose affection had brought her into public at an early
-age.  She had high animal spirits, and a sort of natural
-self-consequence, which the attention of the officers, to whom
-her uncle's good dinners, and her own easy manners recommended
-her, had increased into assurance.  She was very equal,
-therefore, to address Mr. Bingley on the subject of the ball, and
-abruptly reminded him of his promise; adding, that it would be
-the most shameful thing in the world if he did not keep it.  His
-answer to this sudden attack was delightful to their mother's ear:
-
-"I am perfectly ready, I assure you, to keep my engagement; and
-when your sister is recovered, you shall, if you please, name the
-very day of the ball.  But you would not wish to be dancing
-when she is ill."
-
-Lydia declared herself satisfied.  "Oh! yes--it would be much
-better to wait till Jane was well, and by that time most likely
-Captain Carter would be at Meryton again.  And when you have
-given YOUR ball," she added, "I shall insist on their giving one
-also.  I shall tell Colonel Forster it will be quite a shame if he
-does not."
-
-Mrs. Bennet and her daughters then departed, and Elizabeth
-returned instantly to Jane, leaving her own and her relations'
-behaviour to the remarks of the two ladies and Mr. Darcy; the
-latter of whom, however, could not be prevailed on to join in
-their censure of HER, in spite of all Miss Bingley's witticisms on
-FINE EYES.
-
-
-
-Chapter 10
-
-
-The day passed much as the day before had done.  Mrs. Hurst
-and Miss Bingley had spent some hours of the morning with the
-invalid, who continued, though slowly, to mend; and in the
-evening Elizabeth joined their party in the drawing-room.  The
-loo-table, however, did not appear.  Mr. Darcy was writing, and
-Miss Bingley, seated near him, was watching the progress of his
-letter and repeatedly calling off his attention by messages to
-his sister.  Mr. Hurst and Mr. Bingley were at piquet, and Mrs.
-Hurst was observing their game.
-
-Elizabeth took up some needlework, and was sufficiently
-amused in attending to what passed between Darcy and his
-companion.  The perpetual commendations of the lady, either on
-his handwriting, or on the evenness of his lines, or on the length
-of his letter, with the perfect unconcern with which her praises
-were received, formed a curious dialogue, and was exactly in
-union with her opinion of each.
-
-"How delighted Miss Darcy will be to receive such a letter!"
-
-He made no answer.
-
-"You write uncommonly fast."
-
-"You are mistaken.  I write rather slowly."
-
-"How many letters you must have occasion to write in the
-course of a year!  Letters of business, too!  How odious I should
-think them!"
-
-"It is fortunate, then, that they fall to my lot instead of yours."
-
-"Pray tell your sister that I long to see her."
-
-"I have already told her so once, by your desire."
-
-"I am afraid you do not like your pen.  Let me mend it for you.
-I mend pens remarkably well."
-
-"Thank you--but I always mend my own."
-
-"How can you contrive to write so even?"
-
-He was silent.
-
-"Tell your sister I am delighted to hear of her improvement on
-the harp; and pray let her know that I am quite in raptures with
-her beautiful little design for a table, and I think it infinitely
-superior to Miss Grantley's."
-
-"Will you give me leave to defer your raptures till I write again?
-At present I have not room to do them justice."
-
-"Oh! it is of no consequence.  I shall see her in January.  But do
-you always write such charming long letters to her, Mr. Darcy?"
-
-"They are generally long; but whether always charming it is not
-for me to determine."
-
-"It is a rule with me, that a person who can write a long letter
-with ease, cannot write ill."
-
-"That will not do for a compliment to Darcy, Caroline," cried
-her brother, "because he does NOT write with ease.  He studies
-too much for words of four syllables.  Do not you, Darcy?"
-
-"My style of writing is very different from yours."
-
-"Oh!" cried Miss Bingley, "Charles writes in the most careless
-way imaginable.  He leaves out half his words, and blots the
-rest."
-
-"My ideas flow so rapidly that I have not time to express
-them--by which means my letters sometimes convey no ideas
-at all to my correspondents."
-
-"Your humility, Mr. Bingley," said Elizabeth, "must disarm
-reproof."
-
-"Nothing is more deceitful," said Darcy, "than the appearance of
-humility.  It is often only carelessness of opinion, and sometimes
-an indirect boast."
-
-"And which of the two do you call MY little recent piece of
-modesty?"
-
-"The indirect boast; for you are really proud of your defects in
-writing, because you consider them as proceeding from a
-rapidity of thought and carelessness of execution, which, if not
-estimable, you think at least highly interesting.  The power of
-doing anything with quickness is always prized much by the
-possessor, and often without any attention to the imperfection of
-the performance.  When you told Mrs. Bennet this morning that
-if you ever resolved upon quitting Netherfield you should be
-gone in five minutes, you meant it to be a sort of panegyric, of
-compliment to yourself--and yet what is there so very laudable
-in a precipitance which must leave very necessary business
-undone, and can be of no real advantage to yourself or anyone
-else?"
-
-"Nay," cried Bingley, "this is too much, to remember at night all
-the foolish things that were said in the morning.  And yet, upon
-my honour, I believe what I said of myself to be true, and I
-believe it at this moment.  At least, therefore, I did not assume
-the character of needless precipitance merely to show off before
-the ladies."
-
-"I dare say you believed it; but I am by no means convinced that
-you would be gone with such celerity.  Your conduct would be
-quite as dependent on chance as that of any man I know; and if,
-as you were mounting your horse, a friend were to say,  'Bingley,
-you had better stay till next week,' you would probably do it,
-you would probably not go--and at another word, might stay a
-month."
-
-"You have only proved by this," cried Elizabeth, "that Mr.
-Bingley did not do justice to his own disposition.  You have
-shown him off now much more than he did himself."
-
-"I am exceedingly gratified," said Bingley, "by your converting
-what my friend says into a compliment on the sweetness of my
-temper.  But I am afraid you are giving it a turn which that
-gentleman did by no means intend; for he would certainly think
-better of me, if under such a circumstance I were to give a flat
-denial, and ride off as fast as I could."
-
-"Would Mr. Darcy then consider the rashness of your original
-intentions as atoned for by your obstinacy in adhering to it?"
-
-"Upon my word, I cannot exactly explain the matter; Darcy must
-speak for himself."
-
-"You expect me to account for opinions which you choose to
-call mine, but which I have never acknowledged.  Allowing the
-case, however, to stand according to your representation, you
-must remember, Miss Bennet, that the friend who is supposed to
-desire his return to the house, and the delay of his plan, has
-merely desired it, asked it without offering one argument in
-favour of its propriety."
-
-"To yield readily--easily--to the PERSUASION of a friend is
-no merit with you."
-
-"To yield without conviction is no compliment to the understanding
-of either."
-
-"You appear to me, Mr. Darcy, to allow nothing for the
-influence of friendship and affection.  A regard for the requester
-would often make one readily yield to a request, without waiting
-for arguments to reason one into it.  I am not particularly
-speaking of such a case as you have supposed about Mr.
-Bingley.  We may as well wait, perhaps, till the circumstance
-occurs before we discuss the discretion of his behaviour
-thereupon.  But in general and ordinary cases between friend and
-friend, where one of them is desired by the other to change a
-resolution of no very great moment, should you think ill of that
-person for complying with the desire, without waiting to be
-argued into it?"
-
-"Will it not be advisable, before we proceed on this subject, to
-arrange with rather more precision the degree of importance
-which is to appertain to this request, as well as the degree of
-intimacy subsisting between the parties?"
-
-"By all means," cried Bingley; "let us hear all the particulars,
-not forgetting their comparative height and size; for that will
-have more weight in the argument, Miss Bennet, than you may be
-aware of.  I assure you, that if Darcy were not such a great tall
-fellow, in comparison with myself, I should not pay him half so
-much deference.  I declare I do not know a more awful object
-than Darcy, on particular occasions, and in particular places; at
-his own house especially, and of a Sunday evening, when he has
-nothing to do."
-
-Mr. Darcy smiled; but Elizabeth thought she could perceive that
-he was rather offended, and therefore checked her laugh.  Miss
-Bingley warmly resented the indignity he had received, in an
-expostulation with her brother for talking such nonsense.
-
-"I see your design, Bingley," said his friend.  "You dislike an
-argument, and want to silence this."
-
-"Perhaps I do.  Arguments are too much like disputes.  If you and
-Miss Bennet will defer yours till I am out of the room, I shall
-be very thankful; and then you may say whatever you like of me."
-
-"What you ask," said Elizabeth, "is no sacrifice on my side; and
-Mr. Darcy had much better finish his letter."
-
-Mr. Darcy took her advice, and did finish his letter.
-
-When that business was over, he applied to Miss Bingley and
-Elizabeth for an indulgence of some music.  Miss Bingley moved
-with some alacrity to the pianoforte; and, after a polite request
-that Elizabeth would lead the way which the other as politely
-and more earnestly negatived, she seated herself.
-
-Mrs. Hurst sang with her sister, and while they were thus
-employed, Elizabeth could not help observing, as she turned
-over some music-books that lay on the instrument, how frequently
-Mr. Darcy's eyes were fixed on her.  She hardly knew how to
-suppose that she could be an object of admiration to so great a
-man; and yet that he should look at her because he disliked her,
-was still more strange.  She could only imagine, however, at last
-that she drew his notice because there was something more wrong
-and reprehensible, according to his ideas of right, than in any
-other person present.  The supposition did not pain her.  She
-liked him too little to care for his approbation.
-
-After playing some Italian songs, Miss Bingley varied the charm
-by a lively Scotch air; and soon afterwards Mr. Darcy, drawing
-near Elizabeth, said to her:
-
-"Do not you feel a great inclination, Miss Bennet, to seize such
-an opportunity of dancing a reel?"
-
-She smiled, but made no answer.  He repeated the question, with
-some surprise at her silence.
-
-"Oh!" said she, "I heard you before, but I could not immediately
-determine what to say in reply.  You wanted me, I know, to say
-'Yes,' that you might have the pleasure of despising my taste;
-but I always delight in overthrowing those kind of schemes,
-and cheating a person of their premeditated contempt.  I have,
-therefore, made up my mind to tell you, that I do not want to
-dance a reel at all--and now despise me if you dare."
-
-"Indeed I do not dare."
-
-Elizabeth, having rather expected to affront him, was amazed at
-his gallantry; but there was a mixture of sweetness and archness
-in her manner which made it difficult for her to affront anybody;
-and Darcy had never been so bewitched by any woman as he
-was by her.  He really believed, that were it not for the
-inferiority of her connections, he should be in some danger.
-
-Miss Bingley saw, or suspected enough to be jealous; and her
-great anxiety for the recovery of her dear friend Jane received
-some assistance from her desire of getting rid of Elizabeth.
-
-She often tried to provoke Darcy into disliking her guest, by
-talking of their supposed marriage, and planning his happiness in
-such an alliance.
-
-"I hope," said she, as they were walking together in the
-shrubbery the next day, "you will give your mother-in-law a few
-hints, when this desirable event takes place, as to the advantage
-of holding her tongue; and if you can compass it, do sure the
-younger girls of running after officers.  And, if I may mention so
-delicate a subject, endeavour to check that little something,
-bordering on conceit and impertinence, which your lady
-possesses."
-
-"Have you anything else to propose for my domestic felicity?"
-
-"Oh! yes.  Do let the portraits of your uncle and aunt Phillips be
-placed in the gallery at Pemberley.  Put them next to your
-great-uncle the judge.  They are in the same profession, you
-know, only in different lines.  As for your Elizabeth's picture, you
-must not have it taken, for what painter could do justice to those
-beautiful eyes?"
-
-"It would not be easy, indeed, to catch their expression, but their
-colour and shape, and the eyelashes, so remarkably fine, might
-be copied."
-
-At that moment they were met from another walk by Mrs. Hurst
-and Elizabeth herself.
-
-"I did not know that you intended to walk," said Miss Bingley,
-in some confusion, lest they had been overheard.
-
-"You used us abominably ill," answered Mrs. Hurst, "running
-away without telling us that you were coming out."
-
-Then taking the disengaged arm of Mr. Darcy, she left Elizabeth
-to walk by herself.  The path just admitted three.  Mr. Darcy felt
-their rudeness, and immediately said:
-
-"This walk is not wide enough for our party.  We had better go
-into the avenue."
-
-But Elizabeth, who had not the least inclination to remain with
-them, laughingly answered:
-
-"No, no; stay where you are.  You are charmingly grouped, and
-appear to uncommon advantage.  The picturesque would be
-spoilt by admitting a fourth.  Good-bye."
-
-She then ran gaily off, rejoicing as she rambled about, in the
-hope of being at home again in a day or two.  Jane was already
-so much recovered as to intend leaving her room for a couple of
-hours that evening.
-
diff --git a/test/Lwp/bento.c b/test/Lwp/bento.c
deleted file mode 100644
index 1185e87d8..000000000
--- a/test/Lwp/bento.c
+++ /dev/null
@@ -1,342 +0,0 @@
-#include <stdio.h>
-#include <glib.h>
-
-/*
- * To build:
- *   gcc -Wall `pkg-config --libs --cflags glib-2.0` lwp.c
- */
-int verbose = 0;
-
-
-typedef struct {
-  unsigned char  magic[8];
-  guint16 flags;
-  guint16 blockSize;
-  guint16 majorVersion;
-  guint16 minorVersion;
-  guint32  tocOffset;
-  guint32  tocSize;
-} ContainerLabel; /* 24 bytes */
-
-
-#define TOC_NewObject        1
-#define TOC_NewProperty      2
-#define TOC_NewType          3
-#define TOC_ExplicitGen      4
-#define TOC_Offset4Len4      5
-#define TOC_ContdOffset4Len4 6
-#define TOC_Offset8Len4      7
-#define TOC_ContdOffset8Len4 8
-#define TOC_Immediate0       9
-#define TOC_Immediate1       10 /* 0x0a */
-#define TOC_Immediate2       11 /* 0x0b */
-#define TOC_Immediate3       12 /* 0x0c */
-#define TOC_Immediate4       13 /* 0x0d */
-#define TOC_ContdImmediate4  14 /* 0x0e */
-#define TOC_ReferenceListId  15 /* 0x0f */
-#define TOC_EndOfBufr        24 /* 0x16 */
-#define TOC_NOP             255 /* 0xff */
-
-typedef struct {
-  guint32 typeId;
-  guint32 gen_num;
-  guint32 ref_obj_id;
-  /* data */
-} ContainerTocValue;
-
-typedef struct {
-  guint32 propId;
-  GSList *values;
-} ContainerTocProperty;
-
-typedef struct {
-  guint32 objectId;
-  GSList *properties;
-} ContainerTocObject;
-
-typedef GSList *  ContainerToc;       /* objects */
-
-static void
-dump_hex(unsigned char *data, int len)
-{
-	while (len > 0) {
-		int i;
-		int chunk = len < 16 ? len : 16;
-
-		for (i = 0; i < chunk; i++)
-			fprintf( stderr, "%.2x ", data[i] );
-		fprintf( stderr, "| " );
-		for (i = 0; i < chunk; i++)
-			fprintf( stderr, "%c", data[i] < 127 && data[i] > 30 ? data[i] : '.' );
-		fprintf( stderr, "\n" );
-
-		len -= chunk;
-		data += 16;
-	}
-}
-
-static guint16
-read_ushort (FILE *fin)
-{
-  unsigned char data[2];
-  fread (data, 1, 2, fin);
-  return data[0] + (data[1] << 8);
-}
-
-static guint32
-read_ulong (FILE *fin)
-{
-  unsigned char data[4];
-  fread (data, 1, 4, fin);
-  return data[0] + (data[1] << 8) + (data[2] << 16) + (data[3] << 24);
-}
-
-/*
- * The 'Label' is always at the end of the Bento container.
- */
-static ContainerLabel *
-read_label (FILE *fin)
-{
-  ContainerLabel *label = g_new0 (ContainerLabel, 1);
-
-  fseek (fin, -24, SEEK_END);
-  fread (label->magic, 1, 8, fin);
-  label->flags = read_ushort (fin);
-  label->blockSize = read_ushort (fin); /* size of toc in blocks multiples of 1024 */
-  label->majorVersion = read_ushort (fin);
-  label->minorVersion = read_ushort (fin);
-  label->tocOffset = read_ulong (fin);
-  label->tocSize = read_ulong (fin);
-
-  if (verbose)
-    fprintf (stderr, "flags 0x%x blockSize 0x%x, ver: 0x%x.%x "
-	     "toc Offset 0x%x, size 0x%x\n",
-	     label->flags, label->blockSize, label->majorVersion,
-	     label->minorVersion, label->tocOffset, label->tocSize);
-
-  return label;
-}
-
-static ContainerTocValue *
-read_toc_value (FILE *fin)
-{
-  int end = 0;
-  guint8 ctrl;
-  int have_contd = 0;
-  ContainerTocValue *value = g_new0 (ContainerTocValue, 1);
-
-  value->typeId = read_ulong (fin);
-  fprintf( stderr, "Read value 0x%x\n", value->typeId );
-  
-  while (!end && !feof (fin))
-    {
-      ctrl = fgetc (fin);
-      switch (ctrl) {
-      case TOC_NewObject:
-      case TOC_NewProperty:
-      case TOC_NewType:
-	//	fprintf( stderr, "FIXME: Unexpected parent op in value: 0x%x\n", ctrl );
-	ungetc (ctrl, fin);
-	end = 1;
-	break;
-      case TOC_ExplicitGen: {
-	guint32 gen = read_ulong (fin);
-	fprintf (stderr, "Explict Gen: 0x%x\n", gen);
-	break;
-      }
-      case TOC_Offset4Len4: {
-	guint32 offset = read_ulong (fin);
-	fprintf (stderr, "Offset4Len4: 0x%x\n", offset);
-      }
-      case TOC_ContdOffset4Len4: {
-	guint32 offset = read_ulong (fin);
-	fprintf (stderr, "ContdOffset4Len4: 0x%x\n", offset);
-	have_contd = 1;
-      }
-      case TOC_Offset8Len4: {
-	guint8 data[8];
-	fread (data, 1, 8, fin);
-	fprintf (stderr, "Offset8Len4: ");
-	dump_hex (data, 8);
-      }
-      case TOC_ContdOffset8Len4: {
-	guint8 data[8];
-	fread (data, 1, 8, fin);
-	fprintf (stderr, "ContdOffset8Len4: ");
-	dump_hex (data, 8);
-	have_contd = 1;
-      }
-      case TOC_EndOfBufr:
-	if (have_contd) {
-	  have_contd = 0;
-	  fprintf (stderr, "end continuation\n");
-	} else {
-	  end = 1;
-	  fprintf (stderr, "end value\n");
-	}
-	break;
-      case TOC_Immediate4:
-      case TOC_Immediate3:
-      case TOC_Immediate2:
-      case TOC_Immediate1: {
-	guint32 data = read_ulong (fin);
-	fprintf (stderr, "Immediate [%d] 0x%x\n", ctrl, data);
-	break;
-      }
-      case TOC_Immediate0:
-	fprintf (stderr, "Immediate 0\n");
-	break;
-      default:
-	fprintf (stderr, "Unknown value type %d (0x%x)\n", ctrl, ctrl);
-	break;
-      }
-    }  
-
-  return value;
-}
-
-static ContainerTocProperty *
-read_toc_prop (FILE *fin)
-{
-  int end = 0;
-  guint8 ctrl = TOC_NewType;
-  ContainerTocProperty *prop = g_new0 (ContainerTocProperty, 1);
-
-  prop->propId = read_ulong (fin);
-  fprintf (stderr, "Read prop id 0x%x\n", prop->propId);
-
-  while (!end && !feof (fin))
-    {
-      switch (ctrl)
-	{
-	case TOC_NewObject:
-	case TOC_NewProperty:
-	  //	  fprintf( stderr, "FIXME: Unexpected parent op in property: 0x%x\n", ctrl );
-	  ungetc (ctrl, fin);
-	  end = 1;
-	  break;
-	case TOC_NewType:
-	  prop->values = g_slist_append (prop->values,
-					 read_toc_value (fin));
-	  break;
-	case TOC_EndOfBufr:
-	  end = 1;
-	  fprintf (stderr, "end property\n");
-	  break;
-	default:
-	  fprintf (stderr, "Unknown property type %d\n", ctrl);
-	  break;
-	}
-      if (!end)
-	ctrl = fgetc (fin);
-    }
-
-  return prop;
-}
-
-static ContainerTocObject *
-read_toc_object (FILE *fin, ContainerTocObject *last)
-{
-  int end = 0;
-  guint8 ctrl = TOC_NewProperty;
-  ContainerTocObject *object = g_new0 (ContainerTocObject, 1);
-  
-  object->objectId = read_ulong (fin);
-  fprintf (stderr, "Read (%s) object id 0x%x\n",
-	   object->objectId >= 0x1000 ? "non-standard" : "standard",
-	   object->objectId);
-  while (!end && !feof (fin)) {
-    switch (ctrl) {
-    case TOC_NewObject:
-      //      fprintf( stderr, "FIXME: Unexpected parent op in object: 0x%x\n", ctrl );
-      ungetc (ctrl, fin);
-      end = 1;
-      break;
-    case TOC_NewProperty: {
-      ContainerTocProperty *prop = read_toc_prop (fin);
-      object->properties = g_slist_append (object->properties, prop);
-      break;
-    }
-    case TOC_EndOfBufr:
-      end = 1;
-      fprintf (stderr, "end object\n");
-      break;
-    default:
-      fprintf (stderr, "Unknown object type %d\n", ctrl);
-      break;
-    }
-    if (!end)
-      ctrl = fgetc (fin);
-  }
-  return object;
-}
-
-static ContainerToc *
-read_toc (FILE *fin, ContainerLabel *label)
-{
-  int end;
-  GSList *toc = NULL;
-  ContainerTocObject *last = NULL;
-  
-  if (verbose)
-    {
-      guint8 *data = g_malloc (label->tocSize);
-      fprintf (stderr, "Tok:\n");
-      fseek (fin, label->tocOffset, SEEK_SET);
-      fread (data, 1, label->tocSize, fin);
-      dump_hex (data, label->tocSize);
-    }
-
-  fseek (fin, label->tocOffset, SEEK_SET);
-  while (!end && !feof (fin)) {
-    guint8 ctrl = fgetc (fin);
-    switch (ctrl) {
-    case TOC_NewObject: {
-      ContainerTocObject *obj = read_toc_object (fin, last);
-      toc = g_slist_append (toc, obj);
-      last = obj;
-      break;
-    }
-    case TOC_NOP:
-      fprintf (stderr, "NOP\n");
-      break;
-    case TOC_EndOfBufr:
-      end = 1;
-      fprintf (stderr, "end toc\n");
-      break;
-    default:
-      fprintf (stderr, "Unknown code %d\n", ctrl);
-      break;
-    }
-  }
-
-  return (ContainerToc *)toc;
-}
-
-int
-main (int argc, char **argv)
-{
-  int i;
-  const char *fname = NULL;
-  ContainerLabel *label;
-  ContainerToc *toc;
-  FILE *fin;
-
-  for (i = 1; i < argc; i++)
-    {
-      if (argv[i][0] == '-' &&
-	  argv[i][1] == 'v')
-	verbose = 1;
-      else if (!fname)
-	fname = argv[i];
-    }
-
-  fin = fopen (fname, "r");
-
-  label = read_label (fin);
-  toc = read_toc (fin, label);
-
-  fclose (fin);
-
-  return 0;
-} 
diff --git a/test/Lwp/bold.analysis.txt b/test/Lwp/bold.analysis.txt
deleted file mode 100644
index f2d398ee9..000000000
--- a/test/Lwp/bold.analysis.txt
+++ /dev/null
@@ -1,1953 +0,0 @@
-bold1.lwp was modified by Frank Chiulli on Apr 11, 2006
-It was created by opening bold.lwp, changing the 'd' to
-an 'e' and doing a Save AS.
-
-length = 0x3510, 13584, 32 bytes longer than bold.lwp
-Text:
-abce in bold
-==End of Text==
-============================================================================================================
-
-
-00000000: 576f 7264 5072 6f00 0000 0000 0000 0000    WordPro.........
-          |---------------|
-           'WordPro'
-
-00000010: 4c57 5037 0000 0000 0000 0000 0000 0000    LWP7............
-          |-------|
-          LWP7
-
-00000020: 0000 ffff ffff 0000 0000 2e00 0000 0107    ................
-00000030: 0f00 3203 0107 0f00 59c6 a431 0100 fb2c    ..2.....Y..1...,
-               !!                            !!                            <<< varies from bold.lwp (-4, +25) >>>
-               36                            d6
-
-00000040: 0000 1800 1600 576f 7264 2050 726f 2054    ......Word Pro T
-                    0016
-                      || |-----------------------
-                      |   'Word Pro Text File/DFB'                         'Word Pro Text File/DFB'
-                      |
-                      |---> length 0x16 = 22
-
-00000050: 6578 7420 4669 6c65 2f44 4642 8900 a401    ext File/DFB....
-          ----------------------------|
-
-00000060: 4100 02b9 01c0 0140 0250 0250 0250 0250    A......@.P.P.P.P
-                 !!                                                        <<< varies from bold.lwp (+72) >>>
-                 47
-
-00000070: 0150 2d50 0250 0250 0a40 0890 4173 6877    .P-P.P.P.@..Ashw
-                                   9008
-                                     || |-------
-                                      |  'Ashwanth'                        'Ashwanth', Creator
-                                      |
-                                      |-> length 0x08 = 8
-
-00000080: 616e 7468 692d 4941 5bac 3b44 0151 0140    anthi-IA[.;D.Q.@
-          --------| |-------| !!!! !!!!                                    <<< varies from bold.lwp >>>
-                    |       | d42d 4941
-                    |       | |-------|
-                    |       | 443b ac5b                                    11 Apr 2006, 06:17:15  Modified
-                    |-------| Time Stamp
-                    4149 2d69
-                    Time Stamp                                             15 Sep 2004, 23:06:33  Created
-
-
-============================================================================================================
-This might be a table of names and initials as follows:
-   SmartMaster                SM
-   Ashwanth                   A
-   Frank J. Chiulli, Jr.      FJCJ
-
-   0x008c: 0151               0x51 = 81, number of bytes that follow (0x008e : 0x00de)
-           0140 4003          4003, 0x03 = 3, number of pairs
-
-           400d 400b 8a       Prefix ?
-                              400d, 0x0d = 13, length of name + 2
-                              400b, 0x0b = 11, length of name
-           'SmartMaster'
-
-           4804 4002          Prefix ?
-                              Why only 4 bytes?
-                              4804, 0x04 =  4, length of initials + 2
-                              4002, 0x02 =  2, length of initials
-           'SM'
-
-           4d                 Fill ???
-
-           480a 4008 47       Prefix ?
-                              480a, 0x0a = 10, length of name + 2
-                              4008, 0x08 =  8, length of name
-           'Ashwanth'
-
-           4803 4001 40       Prefix ?
-                              4803, 0x03 =  3, length of initials + 2
-                              4001, 0x01 =  1, length of initials
-           'A'
-
-           4817 4015 94       Prefix ?
-                              4817, 0x17 = 23, length of name + 2
-                              4015, 0x15 = 21, length of name
-
-           'Frank J. Chiulli, Jr.'
-
-           4806 4004 43       Prefix ?
-                              4806, 0x06 =  6, length of initials + 2
-                              4004, 0x04 =  4, length of initials
-           'FJCJ'
-
-NOTE: Each length is preceeded by a 0x40 byte.  Is this true everywhere?
-      For all except 'SM' initials there is a byte between the length and the string.  Padding?
-
-============================================================================================================
-
-
-00000090: 4003 400d 400b 8a53 6d61 7274 4d61 7374    @.@.@..SmartMast
-            ||        8a 0b                                                <<< varies from bold.lwp (+1) >>>
-            ||           |||---------------------
-            ||           ||  'SmartMaster'
-            ||           ||
-            ||           ||-> length 0x0b = 11
-            ||
-            ||-> Number of pairs ???
-
-000000a0: 6572 4804 4002 4153 4d48 0a40 0847 4173    erH.@.ASMH.@.GAs
-          ---|        || |--|           4708
-                      || |  |             || |---
-                      || |  |              | 'Ashwanth'                    Creator
-                      || |  |              |
-                      || |  |              |-> length 0x08 = 8
-                      || |--|
-                      || 'SM'                                              Initials for SmartMaster
-                      ||
-                      ||-> length of initials ?
-
-000000b0: 6877 616e 7468 4803 4001 4041 4817 4015    hwanthH.@.@AH.@.
-          -------------|        |---|||        ||
-                                |   |||        94
-                                |---|||
-                                40 01'A'                                   Initials for Creator (Ashwanth)
-                                   ||
-                                   ||-> Length 0x01 = 1
-
-000000c0: 9446 7261 6e6b 204a 2e20 4368 6975 6c6c    .Frank J. Chiull
-          |||------------------------------------
-          15 'Frank J. Chiulli, Jr.'                                       Last Editor
-          ||
-          ||-> length 0x15 = 21
-
-000000d0: 692c 204a 722e 4806 4004 4346 4a43 4a58    i, Jr.H.@.CFJCJX
-          -------------|        |---||--------|
-                                43 04 'FJCJ'                               Initials for Last Editor
-                                   ||
-                                   ||-> length = 0x04 = 4
-
-000000e0: 0250 180a c002 7004 4017 4015 9546 7261    .P....p.@.@..Fra
-                                     |---||------
-                                     95 15 'Frank J. Chiulli, Jr'          Last Editor
-                                        ||
-                                        ||-> length 0x15 = 21
-
-000000f0: 6e6b 204a 2e20 4368 6975 6c6c 692c 204a    nk J. Chiulli, J
-          ---------------------------------------
-
-00000100: 722e 0640 0447 464a 434a ffff ffff 5804    r..@.GFJCJ....X.
-          ---|      |--| |-------|
-                    4704  'FJCJ'                                           Initials for Last Editor
-                      ||
-                      ||-> length 0x04 = 4
-
-00000110: 4002 4002 4002 7102 020d c008 7063 5002    @.@.@.q.....pcP.
-00000120: 5002 6004 4004 4004 7102 020d c006 7063    P.`.@.@.q.....pc      <<< UNIVERSAL_SMARTMASTER_EDITOR missing...see below>>>
-00000130: 5002 5002 6003 0ac0 1d40 1b9b 554e 4956    P.P.`....@..UNIV
-                                   |--| |--------
-                                   9b1b  'UNIVERSAL_ALL_OTHERS_EDITOR'
-                                     ||
-                                     ||-> length 0x1b = 27
-
-00000140: 4552 5341 4c5f 414c 4c5f 4f54 4845 5253    ERSAL_ALL_OTHERS
-          --------------------------------------|
-
-00000150: 5f45 4449 544f 5205 4003 464f 5452 ffff    _EDITOR.@.FOTR..
-          ----------------|     |---||-----|
-                                46 03 'OTR'                                Initials for 'UNIVERSAL_ALL_OTHERS_EDITOR'
-                                   ||
-                                   ||-> length 0x03 = 3
-
-00000160: ffff 5801 4002 4002 4002 7102 020d c008    ..X.@.@.@.q.....
-00000170: 7063 5002 5002 6004 4004 4004 7102 020d    pcP.P.`.@.@.q...
-00000180: c006 7063 5002 5002 6003 0ac0 1e40 1c9c    ..pcP.P.`....@..
-                                             |--|
-                                             9c1c
-                                               ||-> length = 0x1c = 28
-
-00000190: 554e 4956 4552 5341 4c5f 534d 4152 544d    UNIVERSAL_SMARTM
-          |--------------------------------------
-           'UNIVERSAL_SMARTMASTER_EDITOR'
-
-000001a0: 4153 5445 525f 4544 4954 4f52 0440 0245    ASTER_EDITOR.@.E
-          ----------------------------|      |--|
-                                             4502
-                                               ||-> length 0x02 = 2
-
-000001b0: 534d ffff ffff 5803 4002 4002 4002 7102    SM....X.@.@.@.q.
-          |--|
-          'SM'                                                             Initials for 'UNIVERSAL_SMARTMASTER_EDITOR'
-
-000001c0: 020d c008 7063 5002 5002 6004 4004 4004    ....pcP.P.`.@.@.
-000001d0: 7102 020d c006 7063 5002 5002 6003 0ac0    q.....pcP.P.`...
-000001e0: 0a40 0888 4173 6877 616e 7468 0340 0144    .@..Ashwanth.@.D
-               |--| |-----------------|      |--|
-               8808  'Ashwanth'              4401
-                 ||                            ||-> length 0x01 = 1
-                 ||-> length 0x08 = 8
-
-000001f0: 41ff ffff ff58 0240 0240 0240 0271 0202    A....X.@.@.@.q..
-          ||
-          'A'                                                              Initials for 'Ashwanth'
-
-00000200: 0dc0 0870 6350 0250 0260 0440 0440 0471    ...pcP.P.`.@.@.q
-00000210: 0202 0dc0 0670 6350 0250 0260 030e 0700    .....pcP.P.`....
-00000220: 9401 4200 0217 14c1 0101 4002 5101 4342    ..B.......@.Q.CB
-00000230: 0d12 0250 0250 0209 c001 7004 0ba9 0094    ...P.P....p.....
-00000240: 0103 0002 0106 bc00 9401 7f00 0a0c 7101    ..............q.
-00000250: c240 0154 d401 703d 0c02 bd00 9401 7900    .@.T..p=......y.
-00000260: 0706 7101 bc70 0f04 bb00 9401 7e00 030c    ..q..p......~...
-00000270: 7101 8950 4850 4850 4850 4828 b900 9401    q..PHPHPHPH(....
-00000280: 7800 030a 7101 8451 6402 4918 0314 5a00    x...q..Qd.I...Z.
-00000290: 9401 2b00 0204 c102 2102 bc00 9402 2100    ..+.....!.....!.
-000002a0: 030e c101 c278 0142 e17a 2442 703d 0c02    .....x.B.z$Bp=..
-000002b0: bc00 9401 c200 0311 c101 7f41 0221 4001    ...........A.!@.
-000002c0: 42ce cc3f 4270 3d0c 02bb 0094 018f 0005    B..?Bp=.........
-000002d0: 13c1 0189 4101 c350 4842 9999 0350 4842    ....A..PHB...PHB
-000002e0: 6766 2028 b900 9401 8400 060c c101 7841    gf (..........xA
-000002f0: 019a 5164 0248 4815 b900 9401 9a00 040f    ..Qd.HH.........
-00000300: c101 8441 01b4 5164 0248 4871 d002 0cbb    ...A..Qd.HHq....
-00000310: 0094 0189 0005 13c1 017e 4101 8f50 4842    .........~A..PHB
-00000320: 6766 2050 4842 9999 0328 c100 9403 6500    gf PHB...(....e.
-00000330: 0704 13c0 010c c300 9401 8c00 040f c101    ................
-00000340: 8241 01d7 4101 066b d002 0103 03c3 0094    .A..A..k........
-00000350: 0182 0005 0a71 018c 4101 0179 0103 03c5    .....q..A..y....
-00000360: 0094 017d 0108 10c4 012d 0104 3f40 0145    ...}.....-..?@.E
-00000370: 0f02 7f06 ff07 15c7 0094 056e 0003 38c1    ...........n..8.
-00000380: 04af 7801 5001 4001 5001 4007 4007 4007    ..x.P.@.P.@.@.@.
-00000390: 0ac0 0150 0140 0740 0740 0750 030a c001    ...P.@.@.@.P....
-000003a0: 4007 4007 4007 5003 7001 5001 4007 4007    @.@.@.P.p.P.@.@.
-000003b0: 4007 5003 7001 06c8 0094 01f4 0003 0e73    @.P.p..........s
-                           !! !!!! !!!! !!!! !!!!                          <<< varies from bold.lwp >>>
-
-000003c0: 013e 0101 4c01 ff01 ff01 4802 06c6 0094    .>..L.....H.....
-          !!!! !!!! !!!! !!!! !!!! !!!! !!                                 <<< varies from bold.lwp >>>
-
-000003d0: 01f3 0003 100d c001 40ff 40ff 40ff 08c0    ........@.@.@...
-000003e0: 0f08 c064 2ec4 0094 01f0 0003 0fc1 016c    ...d...........l
-000003f0: 4301 7c01 0140 0740 0740 070e c900 9406    C.|..@.@.@......
-00000400: 2200 0610 7104 2140 0140 0b40 0f40 0f50    "...q.!@.@.@.@.P
-00000410: 0140 0104 bf00 9403 6300 040a c101 8178    .@......c......x
-00000420: 0170 0270 0104 be00 9403 6600 0704 13c0    .p.p......f.....
-00000430: 0f04 bf00 9401 8100 0e0e 7103 6350 1260    ..........q.cP.`
-00000440: 0252 e8f8 1240 0104 c000 9403 6400 0712    .R...@......d...
-00000450: 0dc7 ebeb ebeb ebeb ebeb 4801 400f 08c0    ..........H.@...
-00000460: 6404 5a00 9401 0400 0201 085a 0094 010c    d.Z........Z....
-                         !!!! !!!! !!!! !!!! !!                            <<< varies from bold.lwp >>>
-
-00000470: 0002 0108 5a00 9401 0900 0201 085a 0094    ....Z........Z..
-00000480: 010d 0002 0108 5a00 9401 0500 0201 088e    ......Z.........
-00000490: 0094 0111 0002 0a1b c002 7008 4840 5080    ..........p.H@P.
-000004a0: 1e5a 0094 010b 0002 0108 cd00 9401 1600    .Z..............
-000004b0: 0201 06cd 0094 0117 0002 0106 8e00 9401    ................
-000004c0: 1300 020a 1bc0 0270 0848 4050 801e 8e00    .......p.H@P....
-000004d0: 9401 1200 020a 1bc0 0270 0848 4050 801e    .........p.H@P..
-000004e0: 8e00 9401 1400 020a 1bc0 0270 0848 4050    ...........p.H@P
-000004f0: 801e 8e00 9401 1500 020a 1bc0 0270 0848    .............p.H
-00000500: 4050 801e cd00 9401 1900 0201 06cd 0094    @P..............
-00000510: 0118 0002 0106 cd00 9401 1b00 0201 06cd    ................
-00000520: 0094 011c 0002 0106 cd00 9401 1d00 0201    ................
-00000530: 06cd 0094 011e 0002 0106 cd00 9401 1f00    ................
-00000540: 0201 065a 0094 0106 0002 0108 5a00 9401    ...Z........Z...
-00000550: 0700 0201 085a 0094 0108 0002 0108 5a00    .....Z........Z.
-00000560: 9401 0e00 0201 0828 0094 010f 0002 0106    .......(........
-00000570: 2800 9401 1000 0201 06a9 0094 010a 0002    (...............
-00000580: 0106 2f00 9401 2100 0207 1bc0 0214 c002    ../...!.........
-00000590: 1528 0094 0122 0002 0106 2800 9401 2300    .(..."....(...#.
-000005a0: 0201 06b8 0094 0120 0002 0105 2800 9401    ....... ....(...
-000005b0: 2400 0201 0628 0094 0125 0002 0106 2800    $....(...%....(.
-000005c0: 9401 2600 0201 0628 0094 0127 0002 0106    ..&....(...'....
-000005d0: 5a00 9401 2800 0204 c107 3302 5a00 9401    Z...(.....3.Z...
-000005e0: 2900 0204 c101 e002 5a00 9401 2a00 0204    ).......Z...*...
-000005f0: c101 dd02 5a00 9401 2c00 0204 c101 bc02    ....Z...,.......
-00000600: 5a00 9401 2d00 0204 c103 6602 5a00 9401    Z...-.....f.Z...
-00000610: 2e00 0204 c103 6302 5a00 9401 2f00 0204    ......c.Z.../...
-00000620: c103 6402 5a00 9401 3000 0204 c103 6502    ..d.Z...0.....e.
-00000630: 5a00 9401 3100 0204 c107 3702 5a00 9401    Z...1.....7.Z...
-00000640: 3200 0204 c108 2402 5a00 1401 3300 0205    2.....$.Z...3...
-00000650: 0187 0100 005a 0094 0134 0002 04c1 043f    .....Z...4.....?
-00000660: 025a 0094 0135 0002 04c1 01f3 025a 0094    .Z...5.......Z..
-00000670: 0136 0002 04c1 056e 025a 0094 0137 0002    .6.....n.Z...7..
-00000680: 04c1 052a 025a 0094 0138 0002 04c1 0923    ...*.Z...8.....#
-00000690: 025a 0094 0139 0002 04c1 0a25 025a 0094    .Z...9.....%.Z..
-000006a0: 013a 0002 04c1 01ee 025a 0094 013b 0002    .:.......Z...;..
-000006b0: 04c1 01ef 02cd 0094 011a 0002 0106 cd00    ................
-000006c0: 9403 1500 0201 06cd 0094 0316 0002 0106    ................
-000006d0: b000 9401 3e00 0207 4805 4003 4002 0ab1    ....>...H.@.@...
-000006e0: 0094 013f 0002 3f58 0140 0250 0260 0240    ...?..?X.@.P.`.@
-000006f0: 0140 0250 0260 0440 0140 0250 0270 0140    .@.P.`.@.@.P.p.@
-00000700: 0250 0260 010e c004 4004 4014 4880 7801    .P.`....@.@.H.x.
-00000710: 600f 6001 0ec0 0440 0440 1448 8078 0160    `.`....@.@.H.x.`
-00000720: 0f60 0250 0204 8e00 9401 4300 020b 1bc0    .`.P......C.....
-00000730: 0271 0808 4040 5080 1eac 0094 0140 0002    .q..@@P......@..
-00000740: 06c3 ffff ff7f 03ba 0094 01e0 0007 09c1    ................
-00000750: 01d8 7812 41e8 0317 bd00 9401 bc00 0420    ..x.A..........
-00000760: c101 7978 0f40 1448 8078 0140 1448 8078    ..yx.@.H.x.@.H.x
-00000770: 0140 1448 8078 0140 1448 8078 0160 0f04    .@.H.x.@.H.x.`..
-00000780: cc00 940a 2500 050f c10a 1b78 0140 0140    ....%......x.@.@
-00000790: 0140 0151 0a24 04c3 0094 0824 0003 0ac1    .@.Q.$.....$....
-000007a0: 0225 7901 0679 0103 03bb 0094 01c3 0003    .%y..y..........
-000007b0: 27c1 018f 4101 c742 9999 0342 9999 0342    '...A..B...B...B
-000007c0: 9999 0342 9999 0352 9999 0342 9999 0342    ...B...R...B...B
-000007d0: 9999 0342 9999 0316 b900 9401 b400 030b    ...B............
-000007e0: c101 9a41 0226 5048 5048 15cc 0094 0a1b    ...A.&PHPH......
-000007f0: 0005 0f71 0a25 4001 4001 4001 4001 510a    ...q.%@.@.@.@.Q.
-00000800: 1a04 c300 9401 d700 030d c101 8c41 035d    .............A.]
-00000810: 4104 0179 0103 03ca 0094 01ee 000b 0d0d    A..y............
-00000820: c001 40c5 40c5 40c5 08c0 0f20 cb00 9401    ..@.@.@.... ....
-00000830: ef00 0b12 0dc0 0140 0340 0340 0350 0170    .......@.@.@.P.p
-00000840: 0270 0150 0206 c500 9401 2d01 0312 c601    .p.P......-.....
-00000850: 0c01 017d 0101 450f 027f 06ff 0778 240c    ...}..E......x$.
-00000860: c500 9404 3f00 0312 c201 7d01 7001 450f    ....?.....}.p.E.
-00000870: 067f 06ff 0778 1250 1208 c700 9404 af00    .....x.P........
-00000880: 043a c104 a841 056e 4001 5001 4001 5001    .:...A.n@.P.@.P.
-00000890: 4007 4007 4007 0ac0 0150 0140 0740 0740    @.@.@....P.@.@.@
-000008a0: 0750 030a c001 4007 4007 4007 09c0 8058    .P....@.@.@....X
-000008b0: 0140 0740 0740 0750 0370 0106 c800 9401    .@.@.@.P.p......
-000008c0: 3e01 0521 c101 f441 052a 4001 4580 01ff    >..!...A.*@.E...
-000008d0: 01ff 0148 0e40 0c8b 4465 6661 756c 7420    ...H.@..Default
-                         |--| |------------------
-                         8b0c  'Default Text'
-                           ||
-                           ||-> length 0x0c = 12
-
-000008e0: 5465 7874 03c4 0094 016c 0004 0e71 01f0    Text.....l...q..
-          --------|
-
-000008f0: 4001 4001 4001 4001 5002 0ac4 0094 017c    @.@.@.@.P......|
-00000900: 0103 11c1 01f0 4301 8701 0140 0740 0740    ......C....@.@.@
-00000910: 0750 060a c900 9404 2100 0313 c106 2241    .P......!....."A
-00000920: 054f 4001 400b 400f 400f 5001 4003 04b9    .O@.@.@.@.P.@...
-00000930: 0094 0733 0003 0cc1 0226 08c1 e074 4299    ...3.....&...tB.
-00000940: 9903 15bb 0094 01dd 0003 04c1 01da 3fc2    ..............?.
-00000950: 0094 0737 0003 1e0f c002 402d 403c 40b1    ...7......@-@<@.
-00000960: 5063 4002 5002 0cc0 6340 0250 020c c063    Pc@.P...c@.P...c
-00000970: 4002 5002 0ac4 0094 0187 0103 0fc2 017c    @.P............|
-00000980: 0170 0140 0740 0740 0750 020a c800 9405    .p.@.@.@.P......
-00000990: 2a00 031c c201 3e01 7001 4580 01ff 01ff    *.....>.p.E.....
-000009a0: 0148 0b40 0988 4865 6164 696e 6720 3103    .H.@..Heading 1.
-                    |--| |--------------------|
-                    8809  'Heading 1'
-                      ||
-                      ||-> length 0x09 = 9
-
-000009b0: c900 9409 2300 0610 c105 4f78 0140 0f40    ....#.....Ox.@.@
-000009c0: 0f40 0f50 0140 0104 ba00 9401 d800 0310    .@.P.@..........
-000009d0: c101 c441 01e0 4001 41e8 036a 8812 ed0e    ...A..@.A..j....
-000009e0: 2600 940a 2400 040b 7002 6002 4003 7803    &...$...p.`.@.x.
-000009f0: 4002 05c3 0094 0225 0003 0ec1 035d 4108    @......%.....]A.
-00000a00: 2441 0601 7a01 0301 02bb 0094 01c7 0003    $A..z...........
-00000a10: 0bc1 01c3 4101 c842 6666 0534 b900 9402    ....A..Bff.4....
-00000a20: 2600 030f c101 b441 0733 42e1 7a24 42e2    &......A.3B.z$B.
-00000a30: 7a2a 1526 0094 0a1a 0004 0b70 0260 0340    z*.&.......p.`.@
-00000a40: 0278 0240 0305 c300 9403 5d00 0311 c101    .x.@......].....
-00000a50: d741 0225 4102 0148 4850 4841 0102 03c5    .A.%A..HHPHA....
-00000a60: 0094 010c 0106 1173 012d 0101 450f 027f    .......s.-..E...
-00000a70: 06ff 0778 1250 1208 c700 9404 a800 033a    ...x.P.........:
-00000a80: c104 9f41 04af 4001 5001 4001 5001 4007    ...A..@.P.@.P.@.
-00000a90: 4007 4007 0ac0 0150 0140 0740 0740 0750    @.@....P.@.@.@.P
-00000aa0: 030a c001 4007 4007 4007 0ac0 0150 0140    ....@.@.@....P.@
-00000ab0: 0740 0740 0750 0370 0106 c900 9405 4f00    .@.@.P.p......O.
-00000ac0: 0313 c104 2141 0923 4001 400b 400f 400f    ....!A.#@.@.@.@.
-00000ad0: 5004 4001 04bb 0094 01da 0003 0cc1 01d2    P.@.............
-00000ae0: 4101 dd25 c040 7040 09ba 0094 01c4 0003    A..%.@p@........
-00000af0: 1171 01d8 4012 41e8 034a 9999 0342 9999    .q..@.A..J...B..
-00000b00: 030e bb00 9401 c800 030f c101 c741 01cd    .............A..
-00000b10: 4266 6605 6266 6605 2cc7 0094 049f 0003    Bff.bff.,.......
-00000b20: 3771 04a8 4001 5001 4001 5001 4007 4007    7q..@.P.@.P.@.@.
-00000b30: 4007 0ac0 0150 0140 0740 0740 0750 030a    @....P.@.@.@.P..
-00000b40: c001 4007 4007 4007 5003 7001 5001 4007    ..@.@.@.P.p.P.@.
-00000b50: 4007 4007 09c0 8007 bb00 9401 d200 030c    @.@.............
-00000b60: c101 cd41 01da 08c2 6666 052c bb00 9401    ...A....ff.,....
-00000b70: cd00 0320 c101 c841 01d2 4266 6605 6266    ... ...A..Bff.bf
-00000b80: 6605 19c2 80ff ff42 80ff ff42 80ff ff42    f......B...B...B
-00000b90: 80ff ff03 a100 9401 9800 0203 4824 029b    ............H$..
-00000ba0: 0094 0102 0002 0d0d c101 4441 0144 7802    ..........DA.Dx.
-00000bb0: 5101 0102 9b00 9401 4500 020a 14c1 0101    Q.......E.......
-00000bc0: 4002 5101 4402 0700 9401 7300 0225 14c1    @.Q.D.....s..%..
-00000bd0: 0144 4006 4004 4542 6f64 7901 7442 0f12    .D@.@.EBody.tB..
-                      |---||--------|
-                      45 04 'Body'
-                         ||
-                         ||-> length 0x04 = 4
-
-00000be0: 0250 0250 0640 0445 426f 6479 0191 4001    .P.P.@.EBody..@.
-                         |--| |--------|
-                         4504  'Body'
-                            ||
-                            ||-> length 0x04 = 4
-
-00000bf0: 7004 0ba9 0014 0146 0002 0604 6f01 0471    p......F....o..q
-00000c00: 010a 0094 046f 0102 10c2 0471 0171 0191    .....o.....q.q..
-00000c10: 15c0 0250 0219 c001 028e 0094 0156 0002    ...P.........V..
-00000c20: 110d c101 7541 0175 7802 7008 4102 4050    ....uA.ux.p.A.@P
-00000c30: 801e 8c00 9408 2300 1b90 c108 1741 01b1    ......#......A..
-00000c40: 7901 5540 1040 0e8d 4465 6661 756c 7420    y.U@.@..Default
-                         |--| |------------------
-                         8d0e  'Default Footer'
-                           ||
-                           ||-> length 0x0e = 14
-
-00000c50: 466f 6f74 6572 5808 4102 4042 1002 0851    FooterX.A.@B...Q
-          -------------|
-
-00000c60: ff9b 4a05 d003 410a 2b41 0817 5008 4006    ..J...A.+A..P.@.
-                                               |-
-                                               45
-
-00000c70: 4546 6f6f 7465 720f c10a 2541 0303 4002    EFooter...%A..@.
-          -||-------------|
-          06 'Footer'
-          ||
-          ||-> length 0x06 = 6
-
-00000c80: 4016 4014 9344 6566 6175 6c74 2046 6f6f    @.@..Default Foo
-                 |---||--------------------------
-                 93 14 'Default Footer Style'
-                    ||
-                    ||-> length 0x14 = 20
-
-00000c90: 7465 7220 5374 796c 6568 2440 0261 0184    ter Styleh$@.a..
-          ---------------------|
-
-00000ca0: 4101 e041 018f 4101 7941 0181 6020 4001    A..A..A.yA..` @.
-00000cb0: 5901 7f41 0366 4103 6441 0365 6101 0358    Y..A.fA.dA.ea..X
-00000cc0: 0251 0824 53eb ebeb eb01 8c00 940a 2e00    .Q.$S...........
-00000cd0: 0251 c10a 2b0e c101 7540 0270 0841 0240    .Q..+...u@.p.A.@
-00000ce0: 4210 0a07 5003 5205 d003 410a 3d41 0a2b    B...P.R...A.=A.+
-00000cf0: 5008 4006 4546 6f6f 7465 7249 0a2f 4108    P.@.EFooterI./A.
-                 |---||-------------|
-                 45 06 'Footer'
-                    ||
-                    ||-> length 0x06 = 6
-
-00000d00: 2341 0a25 4901 9a79 018f 7901 8160 2040    #A.%I..y..y..` @
-00000d10: 0159 017f 19c1 0103 5802 5101 8c53 ebeb    .Y......X.Q..S..
-00000d20: ebeb 010d 0094 0a2f 0003 2ac1 0a42 410a    ......./..*..BA.
-00000d30: 2c79 0164 4002 510a 2e09 c224 0107 4005    ,y.d@.Q....$..@.
-                                               |-
-                                               46
-
-00000d40: 4653 746f 7279 0a42 410a 2c59 0a30 410a    FStory.BA.,Y.0A.
-          -||----------|
-          05 'Story'
-          ||
-          ||-> length 0x05 = 5
-00000d50: 3041 016d 028e 0094 0155 0002 110d c101    0A.m.....U......
-00000d60: dc41 0817 7802 7008 4102 4050 801e 8b00    .A..x.p.A.@P....
-00000d70: 9408 1700 1b8d 7108 2379 0155 4010 400e    ......q.#y.U@.@.
-                                               |-
-                                               8d
-
-00000d80: 8d44 6566 6175 6c74 2048 6561 6465 7258    .Default HeaderX
-          -||---------------------------------|
-          0e 'Default Header'
-          ||
-          ||-> length 0x0e = 14
-
-00000d90: 0841 0240 4210 0208 51ff 9b4a 50d0 0341    .A.@B...Q..JP..A
-00000da0: 0823 4101 dc50 0840 0645 4865 6164 6572    .#A..P.@.EHeader
-                              |--| |------------|
-                              4506  'Header'
-                                ||
-                                ||-> length 0x06 = 6
-
-00000db0: 0fc1 0a1b 4103 0340 0240 1640 1493 4465    ....A..@.@.@..De
-                                        |--| |---
-                                        9314  'Default Header Style'
-                                          ||
-                                          ||-> length 0x14 = 20
-
-00000dc0: 6661 756c 7420 4865 6164 6572 2053 7479    fault Header Sty
-          ---------------------------------------
-
-00000dd0: 6c65 6824 4002 6101 8441 01e0 4101 8941    leh$@.a..A..A..A
-          ---|
-
-00000de0: 0179 4101 8160 2040 0159 017f 4103 6641    .yA..` @.Y..A.fA
-00000df0: 0364 4103 6561 0103 5802 5101 8253 ebeb    .dA.ea..X.Q..S..
-00000e00: ebeb 018b 0094 0a2b 0002 5071 0a2e 7901    .......+..Pq..y.
-00000e10: 7540 0270 0841 0240 4210 0a07 5003 5250    u@.p.A.@B...P.RP
-00000e20: d003 410a 2e41 0823 5008 4006 4548 6561    ..A..A.#P.@.EHea
-                                     |---||------
-                                     45 06 'Header'
-                                        ||
-                                        ||-> length 0x06 = 6
-
-00000e30: 6465 7249 0a2c 4108 1741 0a1b 4901 8479    derI.,A..A..I..y
-          ------|
-
-00000e40: 0189 7901 8160 2040 0159 017f 19c1 0103    ..y..` @.Y......
-00000e50: 5802 5101 8253 ebeb ebeb 010d 0094 0a2c    X.Q..S.........,
-00000e60: 0003 2cc1 0a2f 4201 1901 7101 6440 0251    ..,../B...q.d@.Q
-00000e70: 0a2b 09c2 2401 0740 0546 5374 6f72 790a    .+..$..@.FStory.
-                              |--| |----------|
-                              4605  'Story'
-                                ||
-                                ||-> length 0x05 = 5
-
-00000e80: 2f42 0119 0151 0a2d 410a 2d41 016d 028f    /B...Q.-A.-A.m..
-00000e90: 0094 0175 000f a10d c10a 2e41 0a2b 4101    ...u.......A.+A.
-00000ea0: 5640 0e40 0c8b 4465 6661 756c 7420 5061    V@.@..Default Pa
-                    |--| |-----------------------
-                    8b0c  'Default Page'
-                      ||
-                      ||-> length 0x0c = 12
-
-00000eb0: 6765 5108 0841 0240 4a02 8804 49ff 8b58    geQ..A.@J...I..X
-          ---|
-
-00000ec0: 0341 0191 09c0 0640 0443 5061 6765 16c0    .A.....@.CPage..
-                              |--| |----------|
-                              4304  'Page'
-                                ||
-                                ||-> length 0x04 = 4
-
-00000ed0: 0348 0240 1440 1291 4465 6661 756c 7420    .H.@.@..Default
-                         |--| |------------------
-                         9112  'Default Page Style'
-                           ||
-                           ||-> length 0x12 = 18
-
-00000ee0: 5061 6765 2053 7479 6c65 6824 400e 400c    Page Styleh$@.@.
-          -----------------------|             |-
-                                               8b
-
-00000ef0: 8b44 6566 6175 6c74 2054 6578 7449 0178    .Default TextI.x
-          -||----------------------------|
-          0c 'Default Text'
-          ||
-          ||-> length 0x0c = 12
-
-00000f00: 4101 e041 017e 4101 7941 0363 6001 6901    A..A.~A.yA.c`.i.
-00000f10: 7f41 0366 4103 6441 0365 6018 4016 9550    .A.fA.dA.e`.@..P
-                                          |---||-
-                                          95 16
-                                             ||-> length 0x16 = 22
-
-00000f20: 7269 6e74 6572 2046 6f6c 6465 7220 5365    rinter Folder Se
-          ---------------------------------------
-          'Printer Folder Setting'
-
-00000f30: 7474 696e 6748 2402 0d00 9401 9600 0326    ttingH$........&
-          -----------|
-
-00000f40: c101 a10e c101 6440 0251 0191 09c2 2c03    ......d@.Q....,.
-00000f50: 0740 0546 5374 6f72 7901 a10a c101 9b41    .@.FStory......A
-               |--| |----------|
-               4605  'Story'
-                 ||
-                 ||-> length 0x05 = 5
-
-00000f60: 019b 4101 6d02 8e00 9401 5400 0211 0dc1    ..A.m.....T.....
-00000f70: 0191 4101 9178 0270 0841 0240 5080 1e8c    ..A..x.p.A.@P...
-00000f80: 0094 0a43 0002 4dc1 0a3d 0ec1 0191 4002    ...C..M..=....@.
-00000f90: 7008 4840 4210 0a07 5003 5205 d003 790a    p.H@B...P.R...y.
-00000fa0: 3d50 0840 0645 466f 6f74 6572 490a 4841    =P.@.EFooterI.HA
-                    |--| |------------|
-                    4506  'Footer'
-                      ||
-                      ||-> length 0x06 = 6
-
-00000fb0: 0823 410a 2549 019a 7901 8f79 0181 6020    .#A.%I..y..y..`
-00000fc0: 4001 5901 7f19 c101 0358 0251 018c 53eb    @.Y......X.Q..S.
-00000fd0: ebeb eb01 0d00 940a 4800 032a c106 3841    ........H..*..8A
-00000fe0: 0a42 7901 6440 0251 0a43 09c0 2440 0740    .By.d@.Q.C..$@.@
-00000ff0: 0546 5374 6f72 7906 3841 0a42 590a 4941    .FStory.8A.BY.IA
-          |--| |----------|
-          4605  'Story'
-            ||
-            ||-> length 0x05 = 5
-
-00001000: 0a49 4101 6d02 8b00 940a 3d00 024f 710a    .IA.m.....=..Oq.
-00001010: 4379 0191 4002 7008 4840 4210 0a07 5003    Cy..@.p.H@B...P.
-00001020: 5250 d003 410a 4341 0a2e 5008 4006 4548    RP..A.CA..P.@.EH
-                                          |---||-
-                                          45 06
-                                             ||-> length 0x06 = 6
-
-00001030: 6561 6465 7249 0a42 4108 1741 0a1b 4901    eaderI.BA..A..I.
-          -----------|
-          'Header'
-
-00001040: 8479 0189 7901 8160 2040 0159 017f 19c1    .y..y..` @.Y....
-00001050: 0103 5802 5101 8253 ebeb ebeb 010d 0094    ..X.Q..S........
-00001060: 0a42 0003 2ac1 0a48 410a 2f79 0164 4002    .B..*..HA./y.d@.
-00001070: 510a 3d09 c024 4007 4005 4653 746f 7279    Q.=..$@.@.FStory
-                                |---||----------|
-                                4605  'Story'
-                                  ||
-                                  ||-> length =0x05 = 5
-
-00001080: 0a48 410a 2f59 0a4b 410a 4b41 016d 028f    .HA./Y.KA.KA.m..
-00001090: 0094 0191 0003 360d c10a 4341 0a3d 4101    ......6...CA.=A.
-000010a0: 5440 0269 0808 4840 4902 8108 c003 4101    T@.i..H@I.....A.
-000010b0: b141 0175 5006 4004 4350 6167 6549 0196    .A.uP.@.CPageI..
-                           |---||--------|
-                           4304  'Page
-                             ||
-                             ||-> length 0x04 = 4
-
-000010c0: 4101 752d c001 4101 7f19 c002 088e 0094    A.u-..A.........
-000010d0: 0174 0002 0b1b c002 7108 0840 4050 801e    .t......q..@@P..
-000010e0: 0000 9401 9b00 0244 0dc0 0259 0989 0bc3    .......D...Y....
-                           !!                                              <<< varies from bold.lwp >>>
-                           36
-
-000010f0: 0c01 016d 08c1 0196 4001 4482 0201 0401    ...m....@.D.....
-          !!                                                               <<< varies from bold.lwp >>>
-          08
-
-00001100: 5204 1201 4020 4020 4020 0bc0 0347 6162    R...@ @ @ ...Gab
-                                        |--| |---
-                                        4703  'abc'
-                                          ||
-                                          ||-> length 0x03 = 3
-                                        !!!!                               <<< varies from bold.lwp >>>
-                                        0445
-
-00001110: 6382 0401 0401 5204 1201 4020 4020 4020    c.....R...@ @ @
-          -|
-            !! !!!! !!!! !!!! !!!! !!!! !!!! !!!!                          <<< varies from bold.lwp >>>
-
-00001120: 0bc0 0142 6501 0353 5345 6e64 0000 940a    ...Be..SSEnd....
-               |--| |||---------------|
-               4201 'e'    'SSEnd'
-                 ||
-                 ||-> length 0x01 = 1
-          !!!! !!!! !!                                                     <<< varies from bold.lwp >>>
-                    64
-
-00001130: 4b00 021b 0ec0 0150 0441 016d 54d4 01f6    K......P.A.mT...
-00001140: 280e 410a 4240 0141 0103 5353 456e 642f    (.A.B@.A..SSEnd/
-                              |---------------|
-                                   'SSEnd'
-00001150: 0094 0164 0002 0f0d c101 9641 0638 7802    ...d.......A.8x.
-00001160: 12c0 0c40 0215 1700 9401 6d00 9975 7101    ...@......m..uq.
-00001170: 6b0e c00e 400c 8b44 6566 6175 6c74 2054    k...@..Default T
-                      |---||---------------------
-                      8b 0c 'Default Text'
-                         ||
-                         ||-> length 0x0c = 12
-
-00001180: 6578 7450 0240 0140 0240 0169 4014 4012    extP.@.@.@.i@.@.
-          ------|                              |-
-                                               92
-
-00001190: 9244 6566 6175 6c74 2054 6578 7420 5374    .Default Text St
-          -||------------------------------------
-          12 'Default Text Style'
-          ||
-          ||-> length 0x12 = 18
-
-000011a0: 796c 6501 4001 4001 4001 7001 4510 041f    yle.@.@.@.p.E...
-          ------|
-
-000011b0: 041f 0409 c101 ee41 01ef 4001 7804 7101    .......A..@.x.q.
-000011c0: f041 056e 4401 7d01 01f3 4101 f441 0622    .A.nD.}...A..A."
-000011d0: 7801 4008 400f 400f 5001 5001 4001 401d    x.@.@.@.P.P.@.@.
-000011e0: 401d 0db0 0094 0172 0002 0a48 0540 0340    @......r...H.@.@
-000011f0: 0261 0904 0300 0094 0a49 0002 1b0e c001    .a.......I......
-00001200: 5004 4101 6d54 d401 f628 0e41 0a48 4001    P.A.mT...(.A.H@.
-00001210: 4101 0353 5345 6e64 1000 9409 8800 0216    A..SSEnd........
-            |---------------|
-                 'SSEnd'
-
-00001220: 7101 9b40 3840 0442 1201 9141 0196 4006    q..@8@.B...A..@.
-00001230: 15c2 0471 0103 0a00 9404 7101 0217 7404    ...q......q...t.
-00001240: 6f01 0191 4109 880a c001 5002 5002 0cc0    o...A.....P.P...
-00001250: 010b c002 025a 0094 0148 0002 0108 5a00    .....Z...H....Z.
-00001260: 9401 4f00 0201 085a 0094 0149 0002 0108    ..O....Z...I....
-00001270: cd00 1401 5900 0203 016d 005a 0094 0147    ....Y....m.Z...G
-00001280: 0002 04c1 031f 02d2 0094 031f 0002 050d    ................
-00001290: c103 2006 5a00 9401 4c00 0201 085a 0094    .. .Z...L....Z..
-000012a0: 0150 0002 04c1 063a 025a 0094 014e 0002    .P.....:.Z...N..
-000012b0: 04c1 047f 02cd 0094 015a 0002 0106 8e00    .........Z......
-000012c0: 9401 5700 0211 0dc1 01d6 4101 d678 0270    ..W.......A..x.p
-000012d0: 0841 0240 5080 1e8e 0094 0158 0002 110d    .A.@P......X....
-000012e0: c101 d441 01c6 7802 7008 4102 4050 801e    ...A..x.p.A.@P..
-000012f0: cd00 1401 5c00 0203 01b1 00cd 0014 015b    ....\..........[
-00001300: 0002 0301 7500 cd00 1401 5e00 0203 01d6    ....u.....^.....
-00001310: 00cd 0014 015f 0002 0301 c600 cd00 1401    ....._..........
-00001320: 6000 0203 01cf 00cd 0014 0161 0002 0301    `..........a....
-00001330: d100 cd00 1401 6200 0203 01d4 005a 0094    ......b......Z..
-00001340: 014a 0002 0108 5a00 9401 4b00 0201 085a    .J....Z...K....Z
-00001350: 0014 0151 0002 0501 6201 0000 2800 1401    ...Q....b...(...
-00001360: 5200 0203 0175 0028 0014 0153 0002 030a    R....u.(...S....
-00001370: 4300 a900 1401 4d00 0206 063b 0001 9000    C.....M....;....
-00001380: 2800 1401 6500 0203 0196 0028 0014 0166    (...e......(...f
-00001390: 0002 0306 3800 b800 9401 6300 0201 0528    ....8.....c....(
-000013a0: 0094 0167 0002 0106 2800 9401 6800 0201    ...g....(...h...
-000013b0: 0628 0094 0169 0002 0106 2800 9401 6a00    .(...i....(...j.
-000013c0: 0201 06cd 0014 015d 0002 0301 dc00 cd00    .......]........
-000013d0: 1403 1700 0203 0817 00cd 0014 0318 0002    ................
-000013e0: 0308 2300 8d00 9401 b100 0f8e c108 2341    ..#...........#A
-000013f0: 01dc 7901 5540 0f40 0d8c 4465 6661 756c    ..y.U@.@..Defaul
-                              |--| |-------------
-                              8c0d  'Default Frame'
-                                ||
-                                ||-> length 0x0d = 13
-
-00001400: 7420 4672 616d 6551 020c 4102 4049 0208    t FrameQ..A.@I..
-          ----------------|
-
-00001410: 51ff 9b58 0341 01c6 4101 9150 0740 0544    Q..X.A..A..P.@.D
-                                             |--|
-                                             4405
-                                               ||-> length 0x05 = 5
-
-00001420: 4672 616d 6516 c003 4802 4015 4013 9244    Frame...H.@.@..D
-          |----------|                    |---||-
-           'Frame'                        92 13
-                                             ||-> length 0x13 = 10
-
-00001430: 6566 6175 6c74 2046 7261 6d65 2053 7479    efault Frame Sty
-          ---------------------------------------
-          'Default Frame Style'
-
-00001440: 6c65 6824 400e 400c 8b44 6566 6175 6c74    leh$@.@..Default
-          ---|             |---||----------------
-                           8b 0c 'Default Text'
-                              ||
-                              ||-> length 0x0c = 12
-
-00001450: 2054 6578 7449 01b4 4101 c441 01c3 4101     TextI..A..A..A.
-          -----------|
-
-00001460: bc41 0363 6008 4001 5901 c241 0366 4103    .A.c`.@.Y..A.fA.
-00001470: 6441 0365 5001 4103 5d06 0000 940a 3000    dA.eP.A.].....0.
-00001480: 0216 0ec0 0150 0441 016d 08c1 0a2f 4001    .....P.A.m.../@.
-00001490: 4101 0353 5345 6e64 d900 9401 dc00 03a2    A..SSEnd........
-            |---------------|
-                 'SSEnd'
-
-000014a0: c101 b10e c101 5540 1240 108f 4465 6661    ......U@.@..Defa
-                                   |--| |--------
-                                   8f10  'Default Drop Cap'
-                                     ||
-                                     ||-> length 0x10 = 16
-
-000014b0: 756c 7420 4472 6f70 2043 6170 5102 0c41    ult Drop CapQ..A
-          ----------------------------|
-
-000014c0: 0240 4902 0851 ff9b 5803 4108 1741 01d6    .@I..Q..X.A..A..
-000014d0: 5009 4007 4644 726f 7043 6170 4901 e241    P.@.FDropCapI..A
-                 |---||---------------|
-                 46 07 'DropCap'
-                    ||
-                    ||-> length 0x07 = 7
-
-000014e0: 01b1 7803 4802 4018 4016 9544 6566 6175    ..x.H.@.@..Defau
-                                |---||-----------
-                                95 16 'Default Drop Cap Style'
-                                   ||
-                                   ||-> length 0x16 = 22
-
-000014f0: 6c74 2044 726f 7020 4361 7020 5374 796c    lt Drop Cap Styl
-          ---------------------------------------
-
-00001500: 6568 2440 0e40 0c8b 4465 6661 756c 7420    eh$@.@..Default
-          -|             |--| |------------------
-                         8b0c  'Default Text'
-                           ||
-                           ||-> length 0x0c = 12
-
-00001510: 5465 7874 4902 2641 01e0 4101 dd41 0179    TextI.&A..A..A.y
-          --------|
-
-00001520: 4101 810b c102 2141 0366 4103 6441 0365    A.....!A.fA.dA.e
-00001530: 6101 0258 0540 0344 ac7a 6202 2570 0340    a..X.@.D.zb.%p.@
-00001540: 0101 0d00 9401 1901 0329 c10a 2c42 0101    .........)..,B..
-00001550: 0171 0164 4002 12c2 6411 0740 0546 5374    .q.d@...d..@.FSt
-                                        |--| |---
-                                        4605  'Story'
-
-00001560: 6f72 790a 2c42 0101 0157 011a 0101 1a01    ory.,B...W......
-          ------|
-
-00001570: 016d 0200 0094 0a2d 0002 160e c001 5004    .m.....-......P.
-00001580: 4101 6d08 c10a 2c40 0141 0103 5353 456e    A.m...,@.A..SSEn
-                                   |-------------
-                                        'SSEnd'
-
-00001590: 640d 0094 01a1 0003 27c1 01a5 4101 9679    d.......'...A..y
-          -|
-
-000015a0: 0164 4002 12c2 6411 0740 0546 5374 6f72    .d@...d..@.FStor
-                                   |--| |--------
-                                   4605  'Story'
-                                     ||
-                                     ||-> length 0x05 = 5
-
-000015b0: 7901 a541 0196 5901 a241 01a2 4101 6d02    y..A..Y..A..A.m.
-          -|
-
-000015c0: 0d00 9406 3800 0322 710a 4879 0164 4002    ....8.."q.Hy.d@.
-000015d0: 12c2 6411 0740 0544 5374 6f72 7971 0a48    ..d..@.DStoryq.H
-                         |--| |----------|
-                         4405  'Story'
-                           ||
-                           ||-> length 0x05 = 5
-
-000015e0: 5906 3941 0639 4101 6d02 8100 9409 8900    Y.9A.9A.m.......
-000015f0: 0207 0dc1 0988 4001 0217 0094 016b 0002    ......@......k..
-00001600: 2bc1 016d 4101 6f0e c00f 400d 8c4e 6f74    +..mA.o...@..Not
-                                     |---||------
-                                     8c 0d 'Note Initials'
-                                        ||
-                                        ||-> length 0x0d = 13
-
-00001610: 6520 496e 6974 6961 6c73 6002 5002 4008    e Initials`.P.@.
-          -----------------------|
-
-00001620: 5940 0218 c001 7804 7101 6c34 5a00 9403    Y@....x.q.l4Z...
-00001630: 2000 0201 087f 0094 063a 0002 31c1 01a7     ........:..1...
-00001640: 15c0 1740 1594 456e 6769 6e65 6572 696e    ...@..Engineerin
-                    |--| |-----------------------
-                    9415  'Engineering Numbering'
-                      ||
-                      ||-> length 0x15 = 21
-
-00001650: 6720 4e75 6d62 6572 696e 6749 0638 400a    g NumberingI.8@.
-00001660: 4f01 0101 0101 0101 01c0 0158 0204 1700    O..........X....
-00001670: 9404 7f00 0286 c104 2b15 c018 4016 954f    ........+...@..O
-                                          |---||-
-                                          95 16
-                                             ||-> length 0x16 = 22
-
-00001680: 7574 6c69 6e65 2028 4e6f 7420 496e 6465    utline (Not Inde
-          ---------------------------------------
-          'Outline (Not Indented)'
-
-00001690: 6e74 6564 2950 0240 0340 0240 0169 4022    nted)P.@.@.@.i@"
-          -----------|
-
-000016a0: 4020 a04c 6566 7420 4a75 7374 6966 6965    @ .Left Justifie
-            |---||-------------------------------
-            a0 20 'Left Justified Outline Numbering'
-               ||
-               ||-> length 0x20 = 32
-
-000016b0: 6420 4f75 746c 696e 6520 4e75 6d62 6572    d Outline Number
-          ---------------------------------------
-
-000016c0: 696e 6701 4001 4001 4001 7001 4510 041f    ing.@.@.@.p.E...
-          ------|
-
-000016d0: 041f 0409 c101 ee41 01ef 4001 4104 2b40    .......A..@.A.+@
-000016e0: 0443 dbf9 ffff 0fc2 010c 010d c105 4f0b    .C............O.
-000016f0: c001 4001 401d 401d 5101 a304 6d00 9401    ..@.@.@.Q...m...
-00001700: d600 036a 14c1 0157 400f 400d 8c44 6566    ...j...W@.@..Def
-                                     |---||------
-                                     8c 0d 'Default Table'
-                                        ||
-                                        ||-> length 0x0d = 13
-
-00001710: 6175 6c74 2054 6162 6c65 5101 0848 c040    ault TableQ..H.@
-          -----------------------|
-
-00001720: 0140 8852 1382 0142 3050 0341 01dc 4101    .@.R...B0P.A..A.
-00001730: d450 0c40 0a89 5375 7065 7254 6162 6c65    .P.@..SuperTable
-                    |--| |----------------------|
-                    890a  'SuperTable'
-                      ||
-                      ||-> length 0x0a = 10
-
-00001740: 16c0 0148 0240 1540 1392 4465 6661 756c    ...H.@.@..Defaul
-                              |--| |-------------
-                              9213  'Default Table Style'
-                                ||
-                                ||-> length 0x13 = 19
-
-00001750: 7420 5461 626c 6520 5374 796c 6508 c101    t Table Style...
-          -------------------------------|
-
-00001760: d841 01da 7901 8129 c001 4101 d704 1200    .A..y..)..A.....
-00001770: 9401 d400 035d c101 d10e c101 5840 1640    .....]......X@.@
-00001780: 1493 4465 6661 756c 7420 5269 6768 7420    ..Default Right
-          |--| |---------------------------------
-          9314  'Default Right Column'
-            ||
-            ||-> length 0x14 = 20
-
-00001790: 436f 6c75 6d6e 5140 0848 4040 0140 8851    ColumnQ@.H@@.@.Q
-          -------------|
-
-000017a0: 1680 4830 4003 4101 d641 01d1 5006 4004    ..H0@.A..A..P.@.
-                                               |-
-                                               43
-
-000017b0: 4343 656c 6c16 c002 5824 400e 400c 8b44    CCell...X$@.@..D
-          -||--------|                    |---||-
-          04 'Cell'                       8b 0c
-          ||                                 ||-> length 0x0c = 12
-          ||-> length 0x04 = 4
-
-000017c0: 6566 6175 6c74 2054 6578 740f c101 c779    efault Text....y
-          --------------------------|
-          'Default Text'
-
-000017d0: 0181 1a12 0094 01c6 0003 8271 01cf 7901    ...........q..y.
-000017e0: 5840 0e40 0c8b 4465 6661 756c 7420 4365    X@.@..Default Ce
-                    |--| |-----------------------
-                    8b0c  'Default Cell'
-                      ||
-                      ||-> length 0x0c = 12
-
-000017f0: 6c6c 5141 0841 0240 4001 4088 521e af01    llQA.A.@@.@.R...
-          ---|
-
-00001800: 4030 4003 4101 cf41 01b1 5006 4004 4343    @0@.A..A..P.@.CC
-                                          |---||-
-                                          43 04 'Cell'
-                                             ||
-                                             ||-> length 0x04 = 4
-
-00001810: 656c 6c16 c003 4802 401a 4018 9744 6566    ell...H.@.@..Def
-          ------|                    |---||------
-                                     97 18 'Default Table Cell Style'
-                                        ||
-                                        ||-> length 0x18 = 24
-
-00001820: 6175 6c74 2054 6162 6c65 2043 656c 6c20    ault Table Cell
-          ---------------------------------------
-
-00001830: 5374 796c 6568 2440 0c40 0a89 5461 626c    Styleh$@.@..Tabl
-          -----------|             |--| |--------
-                                   890a  'Table Text'
-                                     ||
-                                     ||-> length 0x0a = 10
-
-00001840: 6520 5465 7874 4907 3341 01e0 4101 cd41    e TextI.3A..A..A
-          -------------|
-
-00001850: 01bc 4101 810a c107 3741 0179 0212 0094    ..A.....7A.y....
-00001860: 01cf 0003 59c1 01c6 4101 d179 0158 4010    ....Y...A..y.X@.
-00001870: 400e 8d44 6566 6175 6c74 2043 6f6c 756d    @..Default Colum
-            |---||-------------------------------
-            8d 0e 'Default Column'
-               ||
-               ||-> length 0x0e = 14
-
-00001880: 6e51 4008 4840 4001 4088 5116 8048 3040    nQ@.H@@.@.Q..H0@
-          -|
-
-00001890: 0341 01d1 4101 c650 0640 0443 4365 6c6c    .A..A..P.@.CCell
-                                   |--| |-------|
-                                   4304  'Cell'
-                                     ||
-                                     ||-> length 0x04 = 4
-
-000018a0: 16c0 0258 2440 0e40 0c8b 4465 6661 756c    ...X$@.@..Defaul
-                              |--| |-------------
-                              8b0c  'Default Text'
-
-000018b0: 7420 5465 7874 0fc1 01c8 7901 811a 1200    t Text....y.....
-          -------------|
-
-000018c0: 9401 d100 035e c101 cf41 01d4 7901 5840    .....^...A..y.X@
-000018d0: 1540 1392 4465 6661 756c 7420 4c65 6674    .@..Default Left
-               |--| |----------------------------
-               9213  'Default Left Column'
-                 ||
-                 ||-> length 0x13 = 19
-
-000018e0: 2043 6f6c 756d 6e51 4008 4840 4001 4088     ColumnQ@.H@@.@.
-          ----------------|
-
-000018f0: 5116 8048 3040 0341 01d4 4101 cf50 0640    Q..H0@.A..A..P.@
-00001900: 0443 4365 6c6c 16c0 0258 2440 0e40 0c8b    .CCell...X$@.@..
-          |--| |-------|                     |--|
-          4304  'Cell'                       8b0c
-            ||                                 ||-> length 0x0c = 12
-            ||-> length 0x04 = 4
-
-00001910: 4465 6661 756c 7420 5465 7874 0fc1 01d2    Default Text....
-          |---------------------------|
-           'Default Text'
-
-00001920: 7901 811a 3100 9401 6201 021b 1bc0 1240    y...1...b......@
-00001930: 1093 4465 6661 756c 7420 4865 6164 696e    ..Default Headin
-          |--| |---------------------------------
-          9310  'Default Headings'
-            ||
-            ||-> length 0x10 = 16
-
-00001940: 6773 0161 0101 0285 0094 063b 0002 07c1    gs.a.......;....
-          ---|
-
-00001950: 0827 7906 3a00 8500 9401 9000 0207 7101    .'y.:.........q.
-00001960: a441 0175 000d 0094 01e2 0003 2ac4 0101    .A.u........*...
-00001970: 0101 a579 0164 4002 5101 dc09 c224 0107    ...y.d@.Q....$..
-00001980: 4005 8953 746f 7279 0101 0101 a559 01e7    @..Story.....Y..
-            |---||----------|
-            89 05 'Story'
-               ||
-               ||-> length 0x05 = 5
-
-00001990: 4101 e741 016d 020d 0094 0101 0103 27c4    A..A.m........'.
-000019a0: 0119 0101 e279 0164 4002 12c2 6411 0740    .....y.d@...d..@
-000019b0: 0589 5374 6f72 7901 1901 01e2 5f01 0201    ..Story....._...
-          |--| |----------|
-          8905  'Story'
-
-000019c0: 0102 0101 6d02 0000 9401 1a01 0220 0ec0    ....m........ ..
-000019d0: 0153 0402 016d 08c3 0119 0101 43c2 0301    .S...m......C...
-000019e0: 0448 0448 0142 7601 0353 5345 6e64 0d00    .H.H.Bv..SSEnd..
-                           |---------------|
-                                'SSEnd'
-
-000019f0: 9401 a500 0327 c101 e241 01a1 7901 6440    .....'...A..y.d@
-00001a00: 0212 c264 1107 4005 4653 746f 7279 01e2    ...d..@.FStory..
-                           |---||----------|
-                           46 05 'Story'
-                              ||
-                              ||-> length 0x05 = 5
-
-00001a10: 4101 a159 01a6 4101 a641 016d 0200 00a4    A..Y..A..A.m....
-00001a20: 01a2 0002 6101 0ec0 0153 0402 016d 08c1    ....a....S...m..
-00001a30: 01a1 4001 448c 0304 1201 4010 4010 61fd    ..@.D.....@.@.a.
-00001a40: ff70 0840 0450 0154 8203 0412 0140 1040    .p.@.P.T.....@.@
-00001a50: 1061 fdff 7001 452e 8c03 0412 0140 1040    .a..p.E......@.@
-00001a60: 1061 fbff 7008 4002 5002 5482 0304 1201    .a..p.@.P.T.....
-00001a70: 4010 4010 61fb ff70 0145 2e8c 0304 1201    @.@.a..p.E......
-00001a80: 4010 4010 61f7 ff70 0840 0150 0354 8203    @.@.a..p.@.P.T..
-00001a90: 0412 0140 1040 1061 f7ff 7001 452e 8c03    ...@.@.a..p.E...
-00001aa0: 0412 0140 1040 1061 efff 7008 4003 5004    ...@.@.a..p.@.P.
-00001ab0: 5482 0304 1201 4010 4010 61ef ff70 0145    T.....@.@.a..p.E
-00001ac0: 2e8c 0304 1201 4010 4010 61df ff70 0840    ......@.@.a..p.@
-00001ad0: 0550 0554 8203 0412 0140 1040 1061 dfff    .P.T.....@.@.a..
-00001ae0: 7001 452e 8c03 0412 0140 1040 1061 bfff    p.E......@.@.a..
-00001af0: 7008 4001 5006 5482 0304 1201 4010 4010    p.@.P.T.....@.@.
-00001b00: 61bf ff70 0145 298c 0304 1201 4010 4010    a..p.E).....@.@.
-00001b10: 617f ff70 0840 0350 0754 8203 0412 0140    a..p.@.P.T.....@
-00001b20: 1040 1061 7fff 7001 4529 8c03 0412 0140    .@.a..p.E).....@
-00001b30: 1040 1061 fffe 7008 4005 5008 5482 0304    .@.a..p.@.P.T...
-00001b40: 1201 4010 4010 61ff fe70 0145 2982 0304    ..@.@.a..p.E)...
-00001b50: 1201 4010 4010 61ff fd70 0145 288c 0304    ..@.@.a..p.E(...
-00001b60: 1201 4010 4010 61ff fd70 0840 0150 0954    ..@.@.a..p.@.P.T
-00001b70: 8203 0412 0140 1040 1061 fffd 7001 4229    .....@.@.a..p.B)
-00001b80: 0103 5353 456e 6400 00a4 0639 0002 5201    ..SSEnd....9..R.
-          |---------------|
-               'SSEnd'
-
-00001b90: 0ec0 0153 0402 016d 08c1 0638 4001 448c    ...S...m...8@.D.
-00001ba0: 0304 1201 4010 4010 6101 fc70 0840 0150    ....@.@.a..p.@.P
-00001bb0: 0154 8203 0412 0140 1040 1061 fdff 7002    .T.....@.@.a..p.
-00001bc0: 462e 3082 0304 1201 4010 4010 6103 fc70    F.0.....@.@.a..p
-00001bd0: 0145 2e8c 0304 1201 4010 4010 6103 fc70    .E......@.@.a..p
-00001be0: 0840 0150 0254 8203 0412 0140 1040 1061    .@.P.T.....@.@.a
-00001bf0: 07fc 7001 452e 8c03 0412 0140 1040 1061    ..p.E......@.@.a
-00001c00: 07fc 7008 4001 5003 5482 0304 1201 4010    ..p.@.P.T.....@.
-00001c10: 4010 610f fc70 0145 2e8c 0304 1201 4010    @.a..p.E......@.
-00001c20: 4010 610f fc70 0840 0150 0454 8203 0412    @.a..p.@.P.T....
-00001c30: 0140 1040 1061 1ffc 7001 452e 8c03 0412    .@.@.a..p.E.....
-00001c40: 0140 1040 1061 1ffc 7008 4001 5005 5482    .@.@.a..p.@.P.T.
-00001c50: 0304 1201 4010 4010 613f fc70 0145 2e8c    ....@.@.a?.p.E..
-00001c60: 0304 1201 4010 4010 613f fc70 0840 0150    ....@.@.a?.p.@.P
-00001c70: 0654 8203 0412 0140 1040 1061 7ffc 7001    .T.....@.@.a..p.
-00001c80: 452e 8c03 0412 0140 1040 1061 7ffc 7008    E......@.@.a..p.
-00001c90: 4001 5007 5482 0304 1201 4010 4010 61ff    @.P.T.....@.@.a.
-00001ca0: fc70 0145 2e8c 0304 1201 4010 4010 61ff    .p.E......@.@.a.
-00001cb0: fc70 0840 0150 0854 8203 0412 0140 1040    .p.@.P.T.....@.@
-00001cc0: 1061 fffd 7001 452e 8c03 0412 0140 1040    .a..p.E......@.@
-00001cd0: 1061 fffd 7008 4001 5009 5101 0353 5345    .a..p.@.P.Q..SSE
-                                     |-----------
-                                          'SSEnd'
-
-00001ce0: 6e64 1700 9401 6f00 0227 c101 6b41 01f7    nd....o..'..kA..
-          ---|
-
-00001cf0: 0ec0 0b40 0988 4e6f 7465 2044 6174 6560    ...@..Note Date`
-                    |--| |--------------------|
-                    8809  'Note Date'
-                      ||
-                      ||-> length 0x09 = 9
-
-00001d00: 0550 0540 0859 4002 18c0 0178 0471 016c    .P.@.Y@....x.q.l
-00001d10: 347f 0094 01a7 0002 2ec1 01a3 4106 3a0e    4...........A.:.
-00001d20: c011 400f 8e4c 6567 616c 204e 756d 6265    ..@..Legal Numbe
-                 |---||--------------------------
-                 83 0f 'Legal Numbering'
-                    ||
-                    ||-> length 0x0f = 15
-
-00001d30: 7269 6e67 4901 a540 0a4f 0101 0101 0101    ringI..@.O......
-          --------|
-
-00001d40: 0101 c001 5802 0417 0094 042b 0011 8ac4    ....X......+....
-00001d50: 0182 0104 7f0e c014 4012 914f 7574 6c69    ........@..Outli
-                                |---||-----------
-                                91 12 'Outline (Indented)'
-                                   ||
-                                   ||-> length 0x12 = 18
-
-00001d60: 6e65 2028 496e 6465 6e74 6564 2950 0240    ne (Indented)P.@
-          -------------------------------|
-
-00001d70: 0340 0240 0169 4028 4026 a654 7261 6469    .@.@.i@(@&.Tradi
-                                |---||-----------
-                                a6 26 'Traditional Indented Outline Numbering'
-                                   ||
-                                   ||-> length 0x26 = 38
-
-00001d80: 7469 6f6e 616c 2049 6e64 656e 7465 6420    tional Indented
-          ---------------------------------------
-
-00001d90: 4f75 746c 696e 6520 4e75 6d62 6572 696e    Outline Numberin
-          ---------------------------------------
-
-00001da0: 6701 4001 4001 4001 7001 4510 041f 041f    g.@.@.@.p.E.....
-          -|
-
-00001db0: 0409 c101 ee41 01ef 4001 4301 6601 0443    .....A..@.C.f..C
-00001dc0: dbf9 ffff 0fc1 043f 0ec1 0622 0bc0 0140    .......?..."...@
-00001dd0: 0140 1d40 1d51 01a3 047f 0094 01a3 0005    .@.@.Q..........
-00001de0: 2c71 01a7 0ec0 1140 0f8e 4465 6661 756c    ,q.....@..Defaul
-                              |--| |-------------
-                              8e0f  'Default Outline'
-                                ||
-                                ||-> length 0x0f = 15
-
-00001df0: 7420 4f75 746c 696e 6549 01a1 400a 4f01    t OutlineI..@.O.
-          ---------------------|
-
-00001e00: 0101 0101 0101 01c1 0103 5002 045a 0094    ..........P..Z..
-00001e10: 0161 0102 04c1 0b19 0285 0014 0827 0002    .a...........'..
-00001e20: 0908 2000 063b 0008 2300 8500 1401 a400    .. ..;..#.......
-00001e30: 0209 0190 0001 a800 01a3 0000 0094 01e7    ................
-00001e40: 0002 160e c001 5004 4101 6d08 c101 e240    ......P.A.m....@
-00001e50: 0141 0103 5353 456e 6400 0094 0102 0102    .A..SSEnd.......
-               |---------------|
-                    'SSEnd'
-
-00001e60: 200e c001 5304 0201 6d08 c301 0101 0143     ...S...m......C
-00001e70: c203 0104 4804 4801 429f 0103 5353 456e    ....H.H.B...SSEn
-                                   |-------------
-                                        'SSEnd'
-
-00001e80: 6400 00a4 01a6 0002 5401 0ec0 0153 0402    d.......T....S..
-          -|
-
-00001e90: 016d 08c1 01a5 4001 448c 0304 1201 4010    .m....@.D.....@.
-00001ea0: 4010 4010 5001 7808 4001 5001 5482 0304    @.@.P.x.@.P.T...
-00001eb0: 1201 4010 4010 4010 5003 7801 452e 8c03    ..@.@.@.P.x.E...
-00001ec0: 0412 0140 1040 1040 1050 0378 0840 0150    ...@.@.@.P.x.@.P
-00001ed0: 0254 8203 0412 0140 1040 1040 1050 0778    .T.....@.@.@.P.x
-00001ee0: 0145 2e8c 0304 1201 4010 4010 4010 5007    .E......@.@.@.P.
-00001ef0: 7808 4001 5003 5482 0304 1201 4010 4010    x.@.P.T.....@.@.
-00001f00: 4010 500f 7801 452e 8c03 0412 0140 1040    @.P.x.E......@.@
-00001f10: 1040 1050 0f78 0840 0150 0454 8203 0412    .@.P.x.@.P.T....
-00001f20: 0140 1040 1040 1050 1f78 0145 2e8c 0304    .@.@.@.P.x.E....
-00001f30: 1201 4010 4010 4010 501f 7808 4001 5005    ..@.@.@.P.x.@.P.
-00001f40: 5482 0304 1201 4010 4010 4010 503f 7801    T.....@.@.@.P?x.
-00001f50: 452e 8c03 0412 0140 1040 1040 1050 3f78    E......@.@.@.P?x
-00001f60: 0840 0150 0654 8203 0412 0140 1040 1040    .@.P.T.....@.@.@
-00001f70: 1050 7f78 0145 2e8c 0304 1201 4010 4010    .P.x.E......@.@.
-00001f80: 4010 507f 7808 4001 5007 5482 0304 1201    @.P.x.@.P.T.....
-00001f90: 4010 4010 4010 50ff 7801 452e 8c03 0412    @.@.@.P.x.E.....
-00001fa0: 0140 1040 1040 1050 ff78 0840 0150 0854    .@.@.@.P.x.@.P.T
-00001fb0: 8203 0412 0140 1040 1040 1051 ff01 7001    .....@.@.@.Q..p.
-00001fc0: 452e 8c03 0412 0140 1040 1040 1051 ff01    E......@.@.@.Q..
-00001fd0: 7008 4001 5009 5101 0353 5345 6e64 1700    p.@.P.Q..SSEnd..
-                           |---------------|
-                                'SSEnd'
-
-00001fe0: 9401 f700 0243 c101 6f41 01fe 0ec0 0d40    .....C..oA.....@
-00001ff0: 0b8a 426f 6479 2053 696e 676c 6570 0240    ..Body Singlep.@
-          |--| |-------------------------|
-          8a0b  'Body Single'
-            ||
-            ||-> length 0x0b = 11
-
-00002000: 0169 4002 5001 4001 4001 4001 7001 4510    .i@.P.@.@.@.p.E.
-00002010: 041f 041f 0409 c101 ee41 01ef 4001 4101    .........A..@.A.
-00002020: 6d40 0443 ffff ffff 3c17 0094 0182 0102    m@.C....<.......
-00002030: 54c4 0177 0104 2b0e c007 4005 4454 6974    T..w..+...@.DTit
-                                     |---||------
-                                     44 05 'Title
-                                        ||
-                                        ||-> length 0x05 = 5
-
-00002040: 6c65 5002 4006 4002 4007 6940 0250 0140    leP.@.@.@.i@.P.@
-          ---|
-
-00002050: 0140 0140 0170 0145 1004 1f04 1f04 17c0    .@.@.p.E........
-00002060: 0141 016d 4004 4388 f8ff ff4c 0187 0104    .A.m@.C....L....
-00002070: 9f42 017d 0171 052a 4109 230b c001 4001    .B.}.q.*A.#...@.
-00002080: 401d 401d 0d17 0094 0166 0111 59c5 0155    @.@......f..Y..U
-00002090: 0101 7701 0dc0 0d40 0b8a 4e75 6d62 6572    ..w....@..Number
-                              |--| |-------------
-                              8a0b  'Number List'
-                                ||
-                                ||-> length 0x0b = 11
-
-000020a0: 204c 6973 7470 0240 0169 4002 5001 4001     Listp.@.i@.P.@.
-          -----------|
-
-000020b0: 4001 4001 7001 4510 041f 041f 0409 c101    @.@.p.E.........
-000020c0: ee41 01ef 4001 4101 6d40 0443 dff9 ffff    .A..@.A.m@.C....
-000020d0: 0fc2 010c 010d c104 210b c001 4001 401d    ........!...@.@.
-000020e0: 401d 5101 a304 a200 940b 1900 0209 c10b    @.Q.............
-000020f0: 187b 0155 0103 0285 0014 0820 0002 0901    .{.U....... ....
-00002100: 6301 0827 0008 1700 8500 1401 a800 0209    c..'............
-00002110: 01a4 0001 c500 01a7 0017 0094 01fe 0002    ................
-00002120: 57c1 01f7 4201 1401 0dc0 0a40 0847 4275    W...B......@.GBu
-                                        |--| |---
-                                        4708  'Bullet 1'
-                                          ||
-                                          ||-> length 0x08 = 8
-
-00002130: 6c6c 6574 2031 7002 4001 6940 0250 0140    llet 1p.@.i@.P.@
-          -------------|
-
-00002140: 0140 0140 0170 0145 1004 1f04 1f04 09c1    .@.@.p.E........
-00002150: 01ee 4101 ef40 0141 016d 4004 43df f9ff    ..A..@.A.m@.C...
-00002160: ff0f c201 0c01 0dc1 0622 0bc0 0140 0140    ........."...@.@
-00002170: 1d40 1d52 0103 0103 1700 9401 7701 024b    .@.R........w..K
-00002180: c501 6601 0182 010d c00c 400a 8954 6162    ..f.......@..Tab
-                                     |---||------
-                                     89 0a 'Table Text'
-                                        ||
-                                        ||-> length 0x0a = 10
-
-00002190: 6c65 2054 6578 7470 0240 0169 4002 5001    le Textp.@.i@.P.
-          ----------------|
-
-000021a0: 4001 4001 4001 7001 4510 041f 041f 0409    @.@.@.p.E.......
-000021b0: c101 ee41 01ef 4001 4101 6d40 0443 cfff    ...A..@.A.m@.C..
-000021c0: ffff 4a01 7c01 7201 7d01 2517 0094 0155    ..J.|.r.}.%....U
-000021d0: 0102 57c5 0144 0101 6601 0dc0 0b40 0988    ..W..D..f....@..
-                                             |--|
-                                             8809
-                                               ||-> length 0x09 = 9
-
-000021e0: 4865 6164 696e 6720 3350 0340 0840 0340    Heading 3P.@.@.@
-          |--------------------|
-           'Heading 3'
-
-000021f0: 0169 4002 5001 4001 4001 4001 7001 4510    .i@.P.@.@.@.p.E.
-00002200: 041f 041f 0417 c001 4101 6d40 0443 9af8    ........A.m@.C..
-00002210: ffff 08c1 04af 4201 7d01 7401 3e01 0923    ......B.}.t.>..#
-00002220: 0bc0 0140 0140 1d40 1d0d a200 940b 1800    ...@.@.@........
-00002230: 020c c10b 1741 0b19 4301 4401 0202 8500    .....A..C.D.....
-00002240: 1401 6301 0209 01e1 0008 2000 0162 0185    ..c....... ..b..
-00002250: 0014 01c5 0002 0901 a800 01ce 0001 b100    ................
-00002260: 1700 9401 1401 0257 c101 fe42 0128 010d    .......W...B.(..
-00002270: c00a 4008 4742 756c 6c65 7420 3270 0240    ..@.GBullet 2p.@
-                 |---||------------------|
-                 47 08 'Bullet 2'
-                    ||
-                    ||-> length 0x08 = 8
-
-00002280: 0169 4002 5001 4001 4001 4001 7001 4510    .i@.P.@.@.@.p.E.
-00002290: 041f 041f 0409 c101 ee41 01ef 4001 4101    .........A..@.A.
-000022a0: 6d40 0443 dff9 ffff 0fc2 010c 010d c106    m@.C............
-000022b0: 220b c001 4001 401d 401d 5201 1b01 037f    "...@.@.@.R.....
-000022c0: 0094 0103 0102 0e1b c002 6301 0101 0a0a    ..........c.....
-000022d0: c001 5002 0417 0094 0144 0102 57c5 0132    ..P......D..W..2
-000022e0: 0101 5501 0dc0 0b40 0988 4865 6164 696e    ..U....@..Headin
-                              |--| |-------------
-                              8809  'Heading 2'
-                                ||
-                                ||-> length 0x09 = 9
-
-000022f0: 6720 3250 0340 0940 0340 0a69 4002 5001    g 2P.@.@.@.i@.P.
-          ------|
-
-00002300: 4001 4001 4001 7001 4510 041f 041f 0417    @.@.@.p.E.......
-00002310: c001 4101 6d40 0443 9af8 ffff 08c1 04af    ..A.m@.C........
-00002320: 4201 7d01 7401 3e01 0923 0bc0 0140 0140    B.}.t.>..#...@.@
-00002330: 1d40 1d0d a200 940b 1700 0209 710b 1843    .@..........q..C
-00002340: 0132 0101 0285 0014 01e1 0002 0901 db00    .2..............
-00002350: 0163 0101 dc00 8500 1401 ce00 0209 01c5    .c..............
-00002360: 0001 d000 01c6 0017 0094 0128 0102 4fc5    ...........(..O.
-00002370: 0114 0101 3201 0dc0 1340 1190 4669 7273    ....2....@..Firs
-                                   |--| |--------
-                                   9011  'First Line Indent'
-                                     ||
-                                     ||-> length 0x11 = 17
-
-00002380: 7420 4c69 6e65 2049 6e64 656e 7470 0240    t Line Indentp.@
-          -------------------------------|
-
-00002390: 0169 4002 5001 4001 4001 4001 7001 4510    .i@.P.@.@.@.p.E.
-000023a0: 041f 041f 0409 c101 ee41 01ef 4001 4101    .........A..@.A.
-000023b0: 6d40 0443 dfff ffff 0fc2 012d 0125 7f00    m@.C.......-.%..
-000023c0: 9401 1b01 020e 1bc0 0263 0119 010a 0ac0    .........c......
-000023d0: 0150 0204 1700 9401 3201 0257 c501 2801    .P......2..W..(.
-000023e0: 0144 010d c00b 4009 8848 6561 6469 6e67    .D....@..Heading
-                           |---||----------------
-                           88 09 'Heading 1'
-                              ||
-                              ||-> length 0x09 = 9
-
-000023f0: 2031 5002 400b 4002 400c 6940 0250 0140     1P.@.@.@.i@.P.@
-          ---|
-
-00002400: 0140 0140 0170 0145 1004 1f04 1f04 17c0    .@.@.p.E........
-00002410: 0141 016d 4004 4398 f8ff ff08 c104 a842    .A.m@.C........B
-00002420: 017d 0174 013e 0109 230b c001 4001 401d    .}.t.>..#...@.@.
-00002430: 401d 0d85 0014 01db 0002 0901 d500 01e1    @...............
-00002440: 0001 d600 8500 1401 d000 0209 01ce 0001    ................
-00002450: d300 01cf 0085 0014 01d5 0002 0901 d300    ................
-00002460: 01db 0001 d400 8500 1401 d300 0209 01d0    ................
-00002470: 0001 d500 01d1 00a1 0094 0197 0002 0348    ...............H
-00002480: 2402 0500 a401 4400 021a 021b c002 6901    $.....D.......i.
-00002490: 4561 040c 4801 4003 4801 4007 4001 5001    Ea..H.@.H.@.@.P.
-000024a0: 4007 4001 5001 4007 4001 08c0 0250 0250    @.@.P.@.@....P.P
-000024b0: 0270 0250 0250 0208 c002 08c0 0240 0150    .p.P.P.......@.P
-000024c0: 0c50 0974 40ac 3b44 1641 0144 5101 4741    .P.t@.;D.A.DQ.GA
-000024d0: 014f 4101 4c51 0150 5101 4841 0154 4101    .OA.LQ.PQ.HA.TA.
-000024e0: 4e41 0159 4101 5a41 0156 4101 5541 0157    NA.YA.ZA.VA.UA.W
-000024f0: 4101 5841 015c 4101 5b41 015e 4101 5f41    A.XA.\A.[A.^A._A
-00002500: 0160 4101 6141 0162 4101 4941 014a 4101    .`A.aA.bA.IA.JA.
-00002510: 4b41 0151 4101 5241 0153 4101 4d0b c101    KA.QA.RA.SA.M...
-00002520: 6441 0165 4101 6641 0163 4101 6741 0168    dA.eA.fA.cA.gA.h
-00002530: 4101 6941 016a 500c 417f 7f48 0c12 c064    A.iA.jP.A..H...d
-00002540: 5001 4002 5113 1348 080a c001 7063 5003    P.@.Q..H....pcP.
-00002550: 6104 040d c063 7063 08c0 100e c063 7063    a....cpc.....cpc
-00002560: 5004 6113 1348 060a c001 7063 5003 6155    P.a..H....pcP.aU
-00002570: 5548 180a c063 7063 5005 4002 517f 7f48    UH...cpcP.@.Q..H
-00002580: 1812 c064 5005 4002 5154 540d c063 7063    ...dP.@.QTT..cpc
-00002590: 5001 4002 5154 540d c063 7063 5006 4002    P.@.QTT..cpcP.@.
-000025a0: 517f 7f48 0c12 c064 5006 4002 5155 5548    Q..H...dP.@.QUUH
-000025b0: 0e0a c063 7063 5005 4002 517f 7f48 0e12    ...cpcP.@.Q..H..
-000025c0: c064 5005 4002 5006 4011 400f 9854 696d    .dP.@.P.@.@..Tim
-                                     |---||------
-                                     98 0f 'Times New Roman'
-                                        ||
-                                        ||-> length 0x0f = 15
-
-000025d0: 6573 204e 6577 2052 6f6d 616e 0202 0603    es New Roman....
-          ----------------------------|
-
-000025e0: 0504 0502 0304 4802 5701 0101 0101 0101    ......H.W.......
-000025f0: 01c1 0101 480f 400d 964d 5320 5361 6e73    ....H.@..MS Sans
-                           |---||----------------
-                           96 0d 'MS Sans Serif'
-                              ||
-                              ||-> length 0x0d = 13
-
-00002600: 2053 6572 6966 020b 0604 0202 0202 0204     Serif..........
-00002610: 480b 4009 9257 696e 6764 696e 6773 0505    H.@..Wingdings..
-                 |---||--------------------|
-                 92 09 'Wingdings'
-                    ||
-                    ||-> length 0x09 = 9
-
-00002620: 0102 0108 0408 0708 480d 400b 9441 7269    ........H.@..Ari
-                                     |---||------
-                                     94 0b 'Arial Black'
-                                        ||
-                                        ||-> length 0x0b = 11
-
-00002630: 616c 2042 6c61 636b 020b 0a04 0201 0202    al Black........
-          ------------------|
-
-00002640: 0204 4807 4005 8e41 7269 616c 020b 0604    ..H.@..Arial....
-                      |---||----------|
-                      8e 05 'Arial'
-                         ||
-                         ||-> length 0x05 = 5
-
-00002650: 0202 0202 0204 6803 4001 4001 0ac7 0707    ......h.@.@.....
-00002660: 0707 0303 0101 4801 4707 0707 0703 0301    ......H.G.......
-00002670: 0169 015d 4103 1741 0318 5101 7279 0173    .i.]A..A..Q.ry.s
-00002680: 401c 401a 9b47 656f 7267 6520 502e 2042    @.@..George P. B
-                 |---||--------------------------
-                 9b 1a 'George P. Burdell832882267'
-                    ||
-                    ||-> length 0x1a = 26
-
-00002690: 7572 6465 6c6c 3833 3238 3832 3236 3701    urdell832882267.
-          ------------------------------------|
-
-000026a0: 4641 0197 0905 00a4 0101 0001 8a02 1bc0    FA..............
-000026b0: 0269 0102 6104 0441 0201 4003 4801 4007    .i..a..A..@.H.@.
-000026c0: 4001 5001 4007 4001 5001 4007 4001 08c0    @.P.@.@.P.@.@...
-000026d0: 0250 0250 0270 0250 0250 0208 c027 4025    .P.P.p.P.P...'@%
-                                               |-
-                                               a4
-
-000026e0: a463 3a5c 6c6f 7475 735c 736d 6173 7465    .c:\lotus\smaste
-          -||------------------------------------
-
-
-
-
-
-          25 'c:\lotus\smasters\wordpro\default.mwp'
-          ||
-          ||-> length 0x25 = 37
-
-000026f0: 7273 5c77 6f72 6470 726f 5c64 6566 6175    rs\wordpro\defau
-          ---------------------------------------
-
-00002700: 6c74 2e6d 7770 6802 4001 500c 5009 7002    lt.mwph.@.P.P.p.
-          -------------|
-
-00002710: 41f4 024f 4175 746f 2068 7020 d564 6573    A..OAuto hp .des
-                    |---------------------------
-                     'Auto hp ?deskjet 930c series on'
-
-00002720: 6b6a 6574 2039 3330 6320 7365 7269 6573    kjet 930c series
-          ---------------------------------------
-
-00002730: 206f 6e49 0104 4105 9c46 5802 43ff 8007     onI..A..FX.C...
-          ------|
-
-00002740: 0140 0144 ea0a 6f08 6440 0140 0142 2c01    .@.D..o.d@.@.B,.
-00002750: 0140 0142 2c01 0255 4c65 7474 6572 27c0    .@.B,..ULetter'.
-                              |------------|
-                               'Letter'
-
-00002760: 0170 0150 0350 0151 0201 11c4 4449 4e55    .p.P.P.Q....DINU
-00002770: 2252 3402 2443 f40c 86d1 0bc0 020e c015    "R4.$C..........
-00002780: 5001 0ec0 0160 0170 0240 0240 0240 0240    P....`.p.@.@.@.@
-00002790: 0240 013f 3f3f 3f3f 3f3f 1ac0 2454 9819    .@.???????..$T..
-000027a0: 2402 010e c024 5498 1924 0201 5001 420f    $....$T..$..P.B.
-000027b0: 2764 4001 5001 4288 0108 4001 4007 4005    'd@.P.B...@.@.@.
-000027c0: 454e 6530 303a 2840 26a6 4175 746f 2068    ENe00:(@&.Auto h
-                              |--| |-------------
-                              a626  'Auto hp desket 930c series on BLAPTOP'
-                                ||
-                                ||-> length 0x26 = 38
-
-000027d0: 7020 6465 736b 6a65 7420 3933 3063 2073    p deskjet 930c s
-          ---------------------------------------
-
-000027e0: 6572 6965 7320 6f6e 2042 4c41 5054 4f50    eries on BLAPTOP
-          --------------------------------------|
-
-000027f0: 0a40 0888 7769 6e73 706f 6f6c 0250 0840    .@..winspool.P.@
-               |--| |-----------------|
-               8808  'winspool'
-                 ||
-                 ||-> length 0x08 = 8
-
-00002800: 0645 312d 3939 3939 5802 5001 4455 5665    .E1-9999X.P.DUVe
-          |||-------------|
-          || 'E1-999'
-          ||
-          ||-> length 0x06 = 6 ???
-
-
-============================================================================================================
-This looks like it might be information used to populate the Version Statistics
-frame of the File -> Document Propertiess -> Document -> General  window.
-   Version name:  Original Version
-   Created:       9/15/2004, 11:06PM
-   Created by:    Ashwanth
-   Last edited:   4/11/2006, 6:17AM
-   Last editor:   FJCJ
-   Other editors: 2 (SM,A)
-   Revisions:     8
-   Pages:         1
-   Words:         1
-   Characters:    4
-   
-   0x2810: 724f 4002
-                              724f, 0x4f = 79, number of bytes that follow (0x2811 : 0x2860)
-   
-           5012 4010 90       Prefix ?
-                              5012, 0x12 = 18, length of string + 2
-                              4010, 0x10 = 16, length of string
-           'Original Version'
-
-           0a40 0890          Prefix ?
-                              0890, 0x08 =  8, length of string
-           'Ashwanth'
-   
-           692d 4941          Time stamp, 15 Sep 2004, 23:06:33, Created
-   
-           5bac 3b44          Time stamp, 11 Apr 2006, 06:17:15, Last edited
-   
-           0860 0340 0440
-   
-           02                 Number of other editors?  How does it know how long each initial is?
-   
-          'A'
-   
-          'SM'
-
-          4803 4001 4041
-          
-          4806 4004 43        Prefix ?
-                              4806, 0x06 =  6, Length of initials + 2
-                              4004, 0x04 =  4, Length of initials
-          'FJCJ'
-          
-          6c40 ac3b 4416 4101 0151 01
-
-============================================================================================================
-
-
-00002810: 724f 4002 5012 4010 904f 7269 6769 6e61    rO@.P.@..Origina
-                           |---||----------------
-                           90 10 'Original Version'      Version Name
-                              ||
-                              ||-> length 0x10 = 16
-
-00002820: 6c20 5665 7273 696f 6e0a 4008 9041 7368    l Version.@..Ash
-          ---------------------|     |---||------
-                                     90 08 'Ashwanth'    Created By
-                                        ||
-                                        ||-> length 0x08 = 8
-
-00002830: 7761 6e74 6869 2d49 415b ac3b 4408 6003    wanthi-IA[.;D.`.
-          -----------||--------||--------|
-                      |        | 443bac5b
-                      |        |Time Stamp               11 Apr 2006, 06:17:15, Last edited
-                      |--------|
-                       41492d69
-                      Time Stamp                         15 Sep 2004, 23:06:33, Created
-
-00002840: 4004 4002 4153 4d48 0340 0140 4148 0640    @.@.ASMH.@.@AH.@
-                 || |||---|
-                 ||  A  SM                               Other editors
-                 ||
-                 ||-> Number of other editors?
-
-00002850: 0443 464a 434a 6c40 ac3b 4416 4101 0151    .CFJCJl@.;D.A..Q
-          |--| |-------|
-          4304  'FJCJ'                                   Last editor
-            ||
-            ||-> length 0x04 = 4
-
-00002860: 0104 4101 0c41 0109 5101 0d51 0105 4101    ..A..A..Q..Q..A.
-00002870: 1141 010b 4101 1641 0117 4101 1341 0112    .A..A..A..A..A..
-00002880: 4101 1441 0115 4101 1941 0118 4101 1b41    A..A..A..A..A..A
-00002890: 011c 4101 1d41 011e 4101 1f41 0106 4101    ..A..A..A..A..A.
-000028a0: 0741 0108 4101 0e41 010f 4101 1041 010a    .A..A..A..A..A..
-000028b0: 0bc1 0121 4101 2241 0123 4101 2041 0124    ...!A."A.#A. A.$
-000028c0: 4101 2541 0126 4101 2710 c101 2841 0129    A.%A.&A.'...(A.)
-000028d0: 4101 2a41 012b 4101 2c41 012d 4101 2e41    A.*A.+A.,A.-A..A
-000028e0: 012f 4101 3041 0131 4101 3241 0133 4101    ./A.0A.1A.2A.3A.
-000028f0: 3441 0135 4101 3641 0137 4101 3841 0139    4A.5A.6A.7A.8A.9
-00002900: 4101 3a41 013b 5101 1a41 0315 4103 1651    A.:A.;Q..A..A..Q
-00002910: 013e 4101 3f41 0141 4101 4240 1440 1293    .>A.?A.AA.B@.@..
-                                             |--|
-                                             9312
-                                               ||-> length 0x12 = 18
-
-00002920: 4173 6877 616e 7468 3130 3935 3331 3437    Ashwanth10953147
-          |--------------------------------------
-           'Ashwanth1095314793'
-
-00002930: 3933 0103 4101 9809 feff a500 0000 0000    93..A...........
-          ---|
-
-00002940: 0000 0000 9d01 c080 4459 c6a4 3101 3ac0    ........DY..1.:.
-00002950: 022e c101 0250 0240 0440 0143 0104 0202    .....P.@.@.C....
-00002960: 4804 4a01 9526 498f 0b49 2d02 4952 0449    H.J..&I..I-.IR.I
-00002970: 7604 4933 0549 3c05 4945 0549 6404 4969    v.I3.I<.IE.Id.Ii
-00002980: 0549 9104 495b 0449 6d04 494e 0549 5705    .I..I[.Im.IN.IW.
-00002990: 4960 0549 7f04 49be 0449 ac04 49d0 0449    I`.I..I..I..I..I
-000029a0: e204 499a 0449 a304 49fd 0449 f404 49a5    ..I..I..I..I..I.
-000029b0: 0649 0605 490f 0549 1805 4921 0549 2a05    .I..I..I..I!.I*.
-000029c0: 4993 0549 7205 4981 0549 8a05 499c 0549    I..Ir.I..I..I..I
-000029d0: a505 49ae 0549 b705 49c0 0549 cc05 49d8    ..I..I..I..I..I.
-000029e0: 0549 7e02 49e4 0549 f005 49fc 0549 0806    .I~.I..I..I..I..
-000029f0: 4914 0649 2006 492c 0649 3806 4945 0649    I..I .I,.I8.IE.I
-00002a00: 5106 495d 0649 6906 4975 0649 8106 498d    Q.I].Ii.Iu.I..I.
-00002a10: 0649 9906 49c0 0649 cf06 4929 0748 4c51    .I..I..I..I).HLQ
-00002a20: 0e02 4916 0749 7224 49a4 0b49 e30b 496b    ..I..Ir$I..I..Ik
-00002a30: 1249 4512 4957 1249 2d13 4936 1349 8412    .IE.IW.I-.I6.I..
-00002a40: 4962 1349 9912 494e 1249 8d12 493f 1349    Ib.I..IN.I..I?.I
-00002a50: 4c13 4957 1349 560f 4945 0d49 090c 49ae    L.IW.IV.IE.I..I.
-00002a60: 1249 c712 4960 1249 a512 49eb 1249 e012    .I..I`.I..I..I..
-00002a70: 49b3 1349 f612 4901 1349 0c13 4917 1349    I..I..I..I..I..I
-00002a80: 2213 4986 1349 3f11 4970 1349 7b13 498f    ".I..I?.Ip.I{.I.
-00002a90: 1349 9813 49a1 1349 aa13 49e9 1549 d508    .I..I..I..I..I..
-00002aa0: 4956 1149 d21c 49d3 1149 b60b 49bd 1049    IV.I..I..I..I..I
-00002ab0: 7f0e 496c 0249 4a02 4958 0249 3602 4922    ..Il.IJ.IX.I6.I"
-00002ac0: 0449 3d03 49d4 0249 ff02 4926 0349 b902    .I=.I..I..I&.I..
-00002ad0: 4946 1949 7f10 4928 0f49 6724 4984 0b49    IF.I..I(.Ig$I..I
-00002ae0: e802 01fe ffa5 0000 0000 0000 0000 001a    ................
-00002af0: 02c0 8044 59c6 a431 a17b 0802 0705 6804    ...DY..1.{....h.
-00002b00: 0ac0 0150 0249 0406 4802 4202 0602 4a08    ...P.I..H.B...J.
-00002b10: 0704 4e0c 0404 0b05 100b 4a02 1004 4704    ..N.......J...G.
-00002b20: 04ff 5176 bc31 1558 0641 3c05 55ff bd5d    ..Qv.1.X.A<.U..]
-00002b30: d931 2140 0345 ffa7 63fe 3117 4108 0246    .1!@.E..c.1.A..F
-00002b40: 02ff ad65 fe31 1a48 0840 0561 0c04 4004    ...e.1.H.@.a..@.
-00002b50: 4601 ffaa e011 3222 4015 55ff ca26 2f32    F.....2"@.U..&/2
-00002b60: 218d 0913 3f1f 0806 bf01 ffc9 302f 322a    !...?.......0/2*
-00002b70: 4724 1eff 7b52 3032 1755 ff45 1937 3223    G$..{R02.U.E.72#
-00002b80: 4064 45ff 7b18 b832 3342 0381 1549 0d1a    @dE.{..23B...I..
-00002b90: 49c9 1d49 1a1e 49de 1949 711e 4901 1d49    I..I..I..Iq.I..I
-00002ba0: f820 49d4 1349 c807 4948 0749 a002 4999    . I..I..IH.I..I.
-00002bb0: 0749 d90a 493f 2249 c317 49f9 0949 f20a    .I..I?"I..I..I..
-00002bc0: 495c 0b49 4623 494d 1849 3424 49ae 1849    I\.IF#IM.I4$I..I
-00002bd0: 480b 4956 2449 5e17 4945 2449 ec16 49f2    H.IV$I^.IE$I..I.
-00002be0: 0749 b809 49c5 0a49 2324 4988 1449 3309    .I..I..I#$I..I3.
-00002bf0: 4937 0749 3523 4955 1949 2b1e 4907 0849    I7.I5#IU.I+.I..I
-00002c00: 1c08 49d5 0349 bd03 49a7 0349 ce1f 4909    ..I..I..I..I..I.
-00002c10: 2149 8719 4949 1e49 af22 494f 0a49 5022    !I..II.I."IO.IP"
-00002c20: 4932 1549 b619 49ae 2349 5723 4936 0849    I2.I..I.#IW#I6.I
-00002c30: c423 49ac 0849 c522 49bb 2149 fd1d 4914    .#I..I."I.!I..I.
-00002c40: 1949 2e22 4975 2049 6821 49eb 0849 4f03    .I."Iu Ih!I..IO.
-00002c50: 4919 2049 6509 49ae 0649 b706 49be 1349    I. Ie.I..I..I..I
-00002c60: c913 4977 1249 1c16 4936 0a49 0404 4938    ..Iw.I..I6.I..I8
-00002c70: 0449 1a03 4916 0449 8a02 49e3 0949 0c0a    .I..I..I..I..I..
-00002c80: 495e 0d49 e720 4922 0c49 8707 4909 1e49    I^.I. I".I..I..I
-00002c90: 230a 49db 0749 d009 4970 0749 f30d 494b    #.I..I..Ip.I..IK
-00002ca0: 0e49 6315 49ba 0c49 130d 496a 1449 f60f    .Ic.I..I..Ij.I..
-00002cb0: 494d 1049 6f0f 49c4 0f49 e511 491c 1149    IM.Io.I..I..I..I
-00002cc0: ec03 49b0 1549 771b 4925 1649 3719 4904    ..I..Iw.I%.I7.I.
-00002cd0: 0949 371d 4950 0849 5e16 4909 0b49 680a    .I7.IP.I^.I..Ih.
-00002ce0: 496a 0849 f10b 4926 1249 7c09 49aa 0a49    Ij.I..I&.I|.I..I
-00002cf0: 6703 4924 2349 1a22 49d6 2049 a009 4908    g.I$#I."I. I..I.
-00002d00: 1249 da15 491f 0949 3f09 01fc ff95 0000    .I..I..I?.......
-00002d10: 0000 0000 0000 0040 c001 4459 c6a4 319b    .......@..DY..1.
-00002d20: 41d0 1049 2829 49d3 2a48 0bab 59c6 a431    A..I()I.*H..Y..1
-00002d30: bd5d d931 5176 bc31 ca26 2f32 c930 2f32    .].1Qv.1.&/2.0/2
-00002d40: aae0 1132 7b18 b832 a763 fe31 4519 3732    ...2{..2.c.1E.72
-00002d50: ad65 fe31 7b52 3032 1e06 0000 2800 0000    .e.1{R02....(...
-00002d60: bc00 0000 f300 0000 0100 0800 0280 0000    ................
-00002d70: f601 0000 0000 0000 0000 0000 0001 0000    ................
-00002d80: 0000 0000 0000 0000 0000 8000 0080 0000    ................
-00002d90: 0080 8000 8000 0000 8000 8000 8080 0000    ................
-00002da0: c0c0 c000 c0dc c000 f0ca a600 0020 4000    ............. @.
-00002db0: 0020 6000 0020 8000 0020 a000 0020 c000    . `.. ... ... ..
-00002dc0: 0020 e000 0040 0000 0040 2000 0040 4000    . ...@...@ ..@@.
-00002dd0: 0040 6000 0040 8000 0040 a000 0040 c000    .@`..@...@...@..
-00002de0: 0040 e000 0060 0000 0060 2000 0060 4000    .@...`...` ..`@.
-00002df0: 0060 6000 0060 8000 0060 a000 0060 c000    .``..`...`...`..
-00002e00: 0060 e000 0080 0000 0080 2000 0080 4000    .`........ ...@.
-00002e10: 0080 6000 0080 8000 0080 a000 0080 c000    ..`.............
-00002e20: 0080 e000 00a0 0000 00a0 2000 00a0 4000    .......... ...@.
-00002e30: 00a0 6000 00a0 8000 00a0 a000 00a0 c000    ..`.............
-00002e40: 00a0 e000 00c0 0000 00c0 2000 00c0 4000    .......... ...@.
-00002e50: 00c0 6000 00c0 8000 00c0 a000 00c0 c000    ..`.............
-00002e60: 00c0 e000 00e0 0000 00e0 2000 00e0 4000    .......... ...@.
-00002e70: 00e0 6000 00e0 8000 00e0 a000 00e0 c000    ..`.............
-00002e80: 00e0 e000 4000 0000 4000 2000 4000 4000    ....@...@. .@.@.
-00002e90: 4000 6000 4000 8000 4000 a000 4000 c000    @.`.@...@...@...
-00002ea0: 4000 e000 4020 0000 4020 2000 4020 4000    @...@ ..@  .@ @.
-00002eb0: 4020 6000 4020 8000 4020 a000 4020 c000    @ `.@ ..@ ..@ ..
-00002ec0: 4020 e000 4040 0000 4040 2000 4040 4000    @ ..@@..@@ .@@@.
-00002ed0: 4040 6000 4040 8000 4040 a000 4040 c000    @@`.@@..@@..@@..
-00002ee0: 4040 e000 4060 0000 4060 2000 4060 4000    @@..@`..@` .@`@.
-00002ef0: 4060 6000 4060 8000 4060 a000 4060 c000    @``.@`..@`..@`..
-00002f00: 4060 e000 4080 0000 4080 2000 4080 4000    @`..@...@. .@.@.
-00002f10: 4080 6000 4080 8000 4080 a000 4080 c000    @.`.@...@...@...
-00002f20: 4080 e000 40a0 0000 40a0 2000 40a0 4000    @...@...@. .@.@.
-00002f30: 40a0 6000 40a0 8000 40a0 a000 40a0 c000    @.`.@...@...@...
-00002f40: 40a0 e000 40c0 0000 40c0 2000 40c0 4000    @...@...@. .@.@.
-00002f50: 40c0 6000 40c0 8000 40c0 a000 40c0 c000    @.`.@...@...@...
-00002f60: 40c0 e000 40e0 0000 40e0 2000 40e0 4000    @...@...@. .@.@.
-00002f70: 40e0 6000 40e0 8000 40e0 a000 40e0 c000    @.`.@...@...@...
-00002f80: 40e0 e000 8000 0000 8000 2000 8000 4000    @......... ...@.
-00002f90: 8000 6000 8000 8000 8000 a000 8000 c000    ..`.............
-00002fa0: 8000 e000 8020 0000 8020 2000 8020 4000    ..... ...  .. @.
-00002fb0: 8020 6000 8020 8000 8020 a000 8020 c000    . `.. ... ... ..
-00002fc0: 8020 e000 8040 0000 8040 2000 8040 4000    . ...@...@ ..@@.
-00002fd0: 8040 6000 8040 8000 8040 a000 8040 c000    .@`..@...@...@..
-00002fe0: 8040 e000 8060 0000 8060 2000 8060 4000    .@...`...` ..`@.
-00002ff0: 8060 6000 8060 8000 8060 a000 8060 c000    .``..`...`...`..
-00003000: 8060 e000 8080 0000 8080 2000 8080 4000    .`........ ...@.
-00003010: 8080 6000 8080 8000 8080 a000 8080 c000    ..`.............
-00003020: 8080 e000 80a0 0000 80a0 2000 80a0 4000    .......... ...@.
-00003030: 80a0 6000 80a0 8000 80a0 a000 80a0 c000    ..`.............
-00003040: 80a0 e000 80c0 0000 80c0 2000 80c0 4000    .......... ...@.
-00003050: 80c0 6000 80c0 8000 80c0 a000 80c0 c000    ..`.............
-00003060: 80c0 e000 80e0 0000 80e0 2000 80e0 4000    .......... ...@.
-00003070: 80e0 6000 80e0 8000 80e0 a000 80e0 c000    ..`.............
-00003080: 80e0 e000 c000 0000 c000 2000 c000 4000    .......... ...@.
-00003090: c000 6000 c000 8000 c000 a000 c000 c000    ..`.............
-000030a0: c000 e000 c020 0000 c020 2000 c020 4000    ..... ...  .. @.
-000030b0: c020 6000 c020 8000 c020 a000 c020 c000    . `.. ... ... ..
-000030c0: c020 e000 c040 0000 c040 2000 c040 4000    . ...@...@ ..@@.
-000030d0: c040 6000 c040 8000 c040 a000 c040 c000    .@`..@...@...@..
-000030e0: c040 e000 c060 0000 c060 2000 c060 4000    .@...`...` ..`@.
-000030f0: c060 6000 c060 8000 c060 a000 c060 c000    .``..`...`...`..
-00003100: c060 e000 c080 0000 c080 2000 c080 4000    .`........ ...@.
-00003110: c080 6000 c080 8000 c080 a000 c080 c000    ..`.............
-00003120: c080 e000 c0a0 0000 c0a0 2000 c0a0 4000    .......... ...@.
-00003130: c0a0 6000 c0a0 8000 c0a0 a000 c0a0 c000    ..`.............
-00003140: c0a0 e000 c0c0 0000 c0c0 2000 c0c0 4000    .......... ...@.
-00003150: c0c0 6000 c0c0 8000 c0c0 a000 f0fb ff00    ..`.............
-00003160: a4a0 a000 8080 8000 0000 ff00 00ff 0000    ................
-00003170: 00ff ff00 ff00 0000 ff00 ff00 ffff 0000    ................
-00003180: ffff ff00 bcff bcff bcff bcff bcff bcff    ................
-00003190: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000031a0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000031b0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000031c0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000031d0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000031e0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000031f0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003200: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003210: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003220: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003230: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003240: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003250: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003260: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003270: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003280: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003290: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000032a0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000032b0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000032c0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000032d0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000032e0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-000032f0: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003300: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003310: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003320: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003330: bcff bcff bcff bcff 16ff 0500 01ff 0200    ................
-00003340: 9eff 16ff 0800 9eff 18ff 0100 a3ff bcff    ................
-00003350: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003360: bcff bcff bcff bcff bcff bcff bcff bcff    ................
-00003370: bcff bcff bcff bcff bcff 0000 000d 004d    ...............M
-                                          |---||-
-                                          00 0d
-                                             || -> length 0x0d = 13
-
-00003380: 6973 6365 6c6c 616e 656f 7573 0000 1a00    iscellaneous....
-          ----------------------------|
-          'Miscellaneous'                            Document Category
-
-00003390: 4d00 6900 7300 6300 6500 6c00 6c00 6100    M.i.s.c.e.l.l.a.
-000033a0: 6e00 6500 6f00 7500 7300 4669 6c65 5072    n.e.o.u.s.FilePr
-                                   |-------------
-                                    'FileProtection'
-
-000033b0: 6f74 6563 7469 6f6e 0048 6561 6465 7200    otection.Header.
-          ---------------------||---------------|
-                                 'Header'
-
-000033c0: 4c57 5053 7472 6561 6d54 7970 6500 5072    LWPStreamType.Pr
-          |--------------------------------| |---
-           'LWPStreamType'                    'Preview'
-
-000033d0: 6576 6965 7700 576f 7264 5072 6f44 6174    eview.WordProDat
-          -------------| |-----------------------
-                          'WordProData'
-
-000033e0: 6100 ffff 0101 0000 0002 0000 0013 0000    a...............
-          -|
-
-000033f0: 0004 0100 0000 0d06 0001 0002 0300 0000    ................
-00003400: 1300 0000 0d00 0001 0002 0400 0000 1300    ................
-00003410: 0000 05e4 3300 0014 0100 0002 0500 0000    ....3...........
-00003420: 1300 0000 0500 0000 0010 3500 0002 0600    ..........5.....
-                                |--------|
-                                 00003510  File length
-
-00003430: 0000 1300 0000 0d00 0000 0001 0000 0100    ................
-00003440: 0200 0100 0100 0100 0500 0000 0010 0000    ................
-00003450: 0002 0300 0100 0100 0100 0510 0000 0048    ...............H
-00003460: 2d00 0002 0400 0100 0100 0100 0558 2d00    -............X-.
-00003470: 0022 0600 0002 0500 0100 0100 0100 057a    .".............z
-00003480: 3300 0030 0000 0001 0100 0100 1700 0000    3..0............
-00003490: 1500 0000 05c0 3300 000e 0000 0001 0200    ......3.........
-                    ||!!        |---|                                      <<< varies from bold.lwp >>>
-                    ||9f         000e -> Length of string 'LWPStreamType' including null-terminator (0x0e = 14)
-                    |||--------|
-                    || 000033c0 -> points to the start of 'LWPStreamType'
-                    ||
-                    ||-> Number of items that follow ???
-
-000034a0: 0100 1800 0000 1500 0000 05b9 3300 0007    ............3...
-                                     !!        |-                          <<< varies from bold.lwp >>>
-                                     98         0007 -> Length of string 'Header' including null-terminator (0x07 = 7)
-                                     |--------|
-                                      000033b9 -> points to the start of 'Header' [null-terminated]
-
-000034b0: 0000 0001 0300 0100 1800 0000 1500 0000    ................
-          -|
-
-000034c0: 05d6 3300 000c 0000 0001 0400 0100 1800    ..3.............
-            !!        |---|                                                <<< varies from bold.lwp >>>
-            b5         000c -> Length of string 'WordProData' including null-terminator (0x0c = 12)
-            |--------|
-             000033d6 -> points to the start of 'WordProData' [null-terminated]
-
-000034d0: 0000 1500 0000 05ce 3300 0008 0000 0001    ........3.......
-                           !!        |---|                                 <<< varies from bold.lwp >>>
-                           ad        00 08 -> Length of string 'Preview' including null-terminator (0x08 = 8)
-                           |--------|
-                            000033ce -> points to the start of 'Preview' [null-terminated]
-
-000034e0: 0500 0100 1800 0000 1500 0000 05aa 3300    ..............3.
-                                          !!                               <<< varies from bold.lwp >>>
-                                          89
-                                          |-----
-                                           000033aa -> points to the start of 'FileProtection' [null-terminated]
-
-
-000034f0: 000f 0000 0018 ffff a443 4da5 4864 72d7    .........CM.Hdr.
-          -||---|               |---|   |-----|
-            |   |                'CM'    'Hdr'
-            |   |
-            |---| -> length of string 'FileProtection' includeing null-terminator
-
-00003500: 0101 0100 0200 0000 e433 0000 1401 0000    .........3......
-                              !!                                           <<< varies from bold.lwp >>>
-                              c4
-
-
-===============================================================================
-   E n d   o f   F i l e
-===============================================================================
-
-String Summary (Sorted by Address)
------- -------
-
-Address  Code  String
- 0x0044  0x00  Word Pro Text File/DFB
- 0x007a  0x90  Ashwanth                      Creator
- 0x0095  0x8a  SmartMaster
- 0x00ac  0x47  Ashwanth                      Creator
- 0x00b9  0x40  A                             Initials for Creator Ashwanth
- 0x00bf  0x94  Frank J. Chiulli, Jr.         Last Editor
- 0x00d9  0x43  FJCJ                          Initials for Last Editor Frank J. Chiulli, Jr.
- 0x00eb  0x95  Frank J. Chiulli, Jr.         Last Editor
- 0x0104  0x47  FJCJ                          Initials for Last Editor Frank J. Chiulli, Jr.
- 0x013a  0x9b  UNIVERSAL_ALL_OTHERS_EDITOR
- 0x0159  0x46  OTR                           Initials for UNIVERSAL_ALL_OTHERS_EDITOR
- 0x018e  0x9c  UNIVERSAL_SMARTMASTER_EDITOR
- 0x01ae  0x45  SM                            Initials for UNIVERSAL_SMARTMASTER_EDITOR
- 0x01e2  0x88  Ashwanth
- 0x01ee  0x44  A                             Initials for Ashwanth
- 0x08d6  0x8b  Default Text
- 0x09a4  0x88  Heading 1
- 0x0bd5  0x45  Body
- 0x0be6  0x45  Body
- 0x0c46  0x8d  Default Footer
- 0x0c6f  0x45  Footer
- 0x0c83  0x93  Default Footer Style
- 0x0cf3  0x45  Footer
- 0x0d3f  0x46  Story
- 0x0d7f  0x8d  Default Header
- 0x0da8  0x45  Header
- 0x0dbc  0x93  Default Header Style
- 0x0e2b  0x45  Header
- 0x0e78  0x46  Story
- 0x0ea4  0x8b  Default Page
- 0x0ec8  0x43  Page
- 0x0ed6  0x91  Default Page Style
- 0x0eef  0x8b  Default Text
- 0x0f1d  0x95  Printer Folder Setting
- 0x0f52  0x46  Story
- 0x0fa4  0x45  Footer
- 0x0ff0  0x46  Story
- 0x102d  0x45  Header
- 0x1079  0x46  Story
- 0x10b7  0x43  Page
- 0x1125        0x0103 SSEnd
- 0x1148        0x0103 SSEnd
- 0x1175  0x8b  Default Text
- 0x118f  0x92  Default Text Style
- 0x1211        0x0103 SSEnd
- 0x13f8  0x8c  Default Frame
- 0x141e  0x44  Frame
- 0x142d  0x92  Default Frame Style
- 0x1447  0x8b  Default Text
- 0x1491        0x0103 SSEnd
- 0x14aa  0x8f  Default Drop Cap
- 0x14d3  0x46  DropCap
- 0x14e9  0x95  Default Drop Cap Style
- 0x1506  0x8b  Default Text
- 0x155c  0x46  Story
- 0x158a        0x0103 SSEnd
- 0x15aa  0x46  Story
- 0x15d6  0x44  Story
- 0x160b  0x8c  Note Initials
- 0x1644  0x94  Engineering Numbering
- 0x167d  0x95  Outline (Not Indented)
- 0x16a1  0xa0  Left Justified Outline Numbering
- 0x170b  0x8c  Default Table
- 0x1734  0x89  SuperTable
- 0x1748  0x92  Default Table Style
- 0x1790  0x93  Default Right Column
- 0x17af  0x43  Cell
- 0x17bd  0x8b  Default Text
- 0x17e4  0x8b  Default Cell
- 0x180d  0x43  Cell
- 0x181b  0x97  Default Table Cell Style
- 0x183a  0x89  Table Text
- 0x1871  0x8d  Default Column
- 0x189a  0x43  Cell
- 0x18a8  0x8b  Default Text
- 0x18d2  0x92  Default Left Column
- 0x1900  0x43  Cell
- 0x190e  0x8b  Default Text
- 0x1930  0x93  Default Headings
- 0x1981  0x89  Story
- 0x19b0  0x89  Story
- 0x19e7        0x0103 SSEnd
- 0x1a07  0x46  Story
- 0x1b80        0x0103 SSEnd
- 0x1cdb        0x0103 SSEnd
- 0x1cf4  0x88  Note Date
- 0x1d23  0x83  Legal Numbering
- 0x1d59  0x91  Outline (Indented)
- 0x1d79  0xa6  Traditional Indented Outline Numbering
- 0x1de8  0x8e  Default Outline
- 0x1e52        0x0103 SSEnd
- 0x1e7a        0x0103 SSEnd
- 0x1fd7        0x0103 SSEnd
- 0x1ff0  0x8a  Body Single
- 0x203b  0x44  Title
- 0x2098  0x8a  Number List
- 0x212c  0x47  Bullet 1
- 0x218b  0x89  Table Text
- 0x21de  0x88  Heading 3
- 0x2273  0x47  Bullet 2
- 0x22e8  0x88  Heading 2
- 0x237a  0x90  First Line Indent
- 0x23e7  0x88  Heading 1
- 0x25cb  0x98  Times New Roman
- 0x25f7  0x96  MS Sans Serif
- 0x2613  0x92  Wingdings
- 0x262b  0x94  Arial Black
- 0x2645  0x8e  Arial
- 0x2683  0x9b  George P. Burdell11832882267
- 0x26df  0xa4  c:\lotus\smasters\wordpro\default.mwp
- 0x27c8  0xa6  Auto hp desket 930c series on BLAPTOP (default printer??)
- 0x27f2  0x88  winspool
- 0x2800  0x45  E1-999
- 0x2817  0x90  Original Version
- 0x282b  0x90  Ashwanth
- 0x2850  0x43  FJCJ
- 0x291e  0x93  Ashwanth1095314793
- 0x337d  0x00  Miscellaneous
-
-
-===============================================================================
-
-SSEnd
-
-Address  Address  Bytes following
- 0x1125   0x112c  0000 940a 4b00 021b 0ec0 0150 0441 016d 54d4
- 0x1148   0x114f  2f00 9401 6400 020f 0dc1 0196 4106 3878 0212
- 0x1211   0x1218  1000 9409 8800 0216 7101 9b40 3840 0442 1201
- 0x1491   0x1498  d900 9401 dc00 03a2 c101 b10e c101 5540 1240
- 0x158a   0x1591  0d00 9401 a100 0327 c101 a541 0196 7901 6440
- 0x19e7   0x19ee  0d00 9401 a500 0327 c101 e241 01a1 7901 6440
- 0x1b80   0x1b87  0000 a406 3900 0252 010e c001 5304 0201 6d08
- 0x1cdb   0x1ce2  1700 9401 6f00 0227 c101 6b41 01f7 0ec0 0b40
- 0x1e52   0x1e59  0000 9401 0201 0220 0ec0 0153 0402 016d 08c3
- 0x1e7a   0x1e81  0000 a401 a600 0254 010e c001 5304 0201 6d08
- 0x1fd7   0x1fde  1700 9401 f700 0243 c101 6f41 01fe 0ec0 0d40
-
diff --git a/test/Lwp/bold.lwp b/test/Lwp/bold.lwp
deleted file mode 100644
index 48cc03263..000000000
--- a/test/Lwp/bold.lwp
+++ /dev/null
diff --git a/test/Lwp/bold.txt b/test/Lwp/bold.txt
deleted file mode 100644
index 07236b561..000000000
--- a/test/Lwp/bold.txt
+++ /dev/null
@@ -1 +0,0 @@
-abcd in bold
diff --git a/test/Lwp/empty.lwp b/test/Lwp/empty.lwp
deleted file mode 100644
index d84e5d008..000000000
--- a/test/Lwp/empty.lwp
+++ /dev/null
diff --git a/test/Lwp/helloworl.lwp b/test/Lwp/helloworl.lwp
deleted file mode 100644
index 4c8b9bfe9..000000000
--- a/test/Lwp/helloworl.lwp
+++ /dev/null
diff --git a/test/Lwp/helloworl.txt b/test/Lwp/helloworl.txt
deleted file mode 100644
index 0c55c8666..000000000
--- a/test/Lwp/helloworl.txt
+++ /dev/null
@@ -1 +0,0 @@
-Hello Worl
diff --git a/test/Lwp/helloworld.lwp b/test/Lwp/helloworld.lwp
deleted file mode 100644
index 9e9b00e62..000000000
--- a/test/Lwp/helloworld.lwp
+++ /dev/null
diff --git a/test/Lwp/helloworld.txt b/test/Lwp/helloworld.txt
deleted file mode 100644
index 557db03de..000000000
--- a/test/Lwp/helloworld.txt
+++ /dev/null
@@ -1 +0,0 @@
-Hello World
diff --git a/test/Lwp/italics.lwp b/test/Lwp/italics.lwp
deleted file mode 100644
index c41fd0924..000000000
--- a/test/Lwp/italics.lwp
+++ /dev/null
diff --git a/test/Lwp/italics.txt b/test/Lwp/italics.txt
deleted file mode 100644
index 98472a707..000000000
--- a/test/Lwp/italics.txt
+++ /dev/null
@@ -1 +0,0 @@
-abcd in italics
diff --git a/test/Lwp/lotusWordPro.lwp b/test/Lwp/lotusWordPro.lwp
deleted file mode 100644
index e51383fd3..000000000
--- a/test/Lwp/lotusWordPro.lwp
+++ /dev/null
diff --git a/test/Lwp/lotusWordPro.txt b/test/Lwp/lotusWordPro.txt
deleted file mode 100644
index 097ee81ba..000000000
--- a/test/Lwp/lotusWordPro.txt
+++ /dev/null
@@ -1,7 +0,0 @@
-Hi,
-
-This is Ashwanth. I am right now experimenting with the Lotus SmartSuite97. Well, our OpenOffice is any day better than this suite ;-) :-). Anyway, in order that OpenOffice is truly as great as it is supposed to be, we need to make it  compatible with the Lotus SmartSuite file formats as well. And so, here I am, ready to take off.
-
-Thanks and regards
-Ashwanth
-
diff --git a/test/Lwp/lwp.c b/test/Lwp/lwp.c
deleted file mode 100644
index 3c16570e6..000000000
--- a/test/Lwp/lwp.c
+++ /dev/null
@@ -1,238 +0,0 @@
-#include <stdio.h>
-#include <malloc.h>
-
-// This is only any good for austin.lwp - oddly.
-
-int verbose = 0;
-int init_offset = 68;
-
-// Odd section:
-// 02 02 3f bf 62 65 20 6f 6e 20 68 69 73 20 66 69 | ..?.be on his fi
-// 72 73 74 20 65 6e 74 65 72 69 6e 67 20 61 20 6e | rst entering a n
-// 65 69 67 68 62 6f 75 72 68 6f 6f 64 2c 20 74 68 | eighbourhood, th
-// 69 73 20 74 72 75 74 68 20 69 73 20 73 6f 20 77 | is truth is so w
-// 65 6c 6c 01 c0 02 53 53 45 6e 64 00 00 94 02 2e | ell...SSEnd.....
-// 00 02 6a c1 02 2f 41 02 2d 48 0f 61 01 6d 46 8d | ..j../A.-H.a.mF.
-// 46 c3 01 f6 28 0e 41 01 96 40 01 42 | F...(.A..@.B
-
-
-static unsigned char
-my_fgetc (FILE *fin)
-{
-		/* Very, very odd: custom hacks for austin.lwp */
-		switch (ftell (fin)) {
-
-		case 0x28c4: // 0xc6 - mid-string
-		case 0x2b67: // 0xc2 - mid string
-		case 0x2fd4: // 0xc1 - c1 01 02
-				fgetc (fin); // skip duff byte
-				break;
-		default:
-				break;
-		};
-		return fgetc (fin);
-}
-
-static void
-dump_string (FILE *fin, int len)
-{
-	int i;
-	fprintf(stderr ,"(%d): '", len);
-	for (i = 0; i < len; i++) {
-			unsigned char c = my_fgetc (fin);
-			if (c >= 0x20 && c < 0x80)
-					fprintf (stderr, "%c", c);
-			else
-					fprintf (stderr, "#0x%x#", c);
-	}
-	fprintf (stderr,"'\n");
-}
-
-#if 0
-static int
-dump_runs(unsigned char *data, int len)
-{
-	int i;
-	int pos = 0;
-
-	while (pos < len) {
-		int typea = data[0]; // Continuations show hdr to be 4 bytes
-		int typeb = data[1];
-		int run_len = data[2];
-		int typec = data[3];
-
-		if (run_len > len - 5)
-			run_len = len - 5;
-		
-		if (typea == 0x0b &&
-		    typeb == 0xc0) { // starter thing
-			fprintf( stderr, "String: [0x%x]\n", typeb );
-			dump_string( data + 4, run_len );
-		} else if (typea == 0x82 &&
-			   typeb == 0x02 &&
-			   run_len == 0x04) {
-			// CRLF ? - end marker anyway.
-			break;
-		} else if (typeb == 0x02) {
-			fprintf( stderr, "StringC: [0x%x]\n", typeb );
-			dump_string( data + 4, run_len );
-		} else {
-			fprintf( stderr, "unknown type 0x%x 0x%x 0x%x 0x%x\n", 
-				 typea, typeb, run_len, typec );
-			break;
-		}
-		pos += run_len + 4;
-		data += run_len + 4;
-	}	
-	return pos;
-}
-#endif
-
-static void
-dump_hex(unsigned char *data, int len)
-{
-	while (len > 0) {
-		int i;
-		int chunk = len < 16 ? len : 16;
-
-		for (i = 0; i < chunk; i++)
-			fprintf( stderr, "%.2x ", data[i] );
-		fprintf( stderr, "| " );
-		for (i = 0; i < chunk; i++)
-			fprintf( stderr, "%c", data[i] < 127 && data[i] > 30 ? data[i] : '.' );
-		fprintf( stderr, "\n" );
-
-		len -= chunk;
-		data += 16;
-	}
-}
-
-static void
-skip_to_at (FILE *fin, unsigned char code, int print)
-{
-		int i;
-		unsigned char skip_data[65536];
-		skip_data[0] = code;
-		for (i = 1; (skip_data[i] = my_fgetc (fin)) != '@' && i < sizeof (skip_data); i++);
-		if (print)
-				dump_hex (skip_data, i + 1);
-}
-
-
-static void
-scan_text (FILE *fin)
-{
-		int end_of_run = 0;
-		while (!feof (fin) && !end_of_run) {
-				unsigned char codea = my_fgetc (fin);
-				unsigned char codeb = my_fgetc (fin);
-				int code = codeb + (codea << 8);
-				int skip = 0;
-				switch (code) {
-				case 0x0202:
-				case 0x0bc0: {
-						unsigned char len = my_fgetc (fin);
-						unsigned char dummy = my_fgetc (fin);
-						dump_string (fin, len);
-						break;
-				}
-				case 0x01c0: // for some reason we often get 0x01c002
-						codeb = my_fgetc (fin);
-						if (codeb != 0x02)
-						{
-								fprintf (stderr, "Odd 0x1c0\n");
-								end_of_run = 1;
-								break;
-						}
-						// drop through
-				case 0x0102: { /* SSE */
-						char data[29];
-						int len = 22;
-						fprintf (stderr, "SSE\n");
-						fread (data, 1, len, fin); // or 29 ?
-						if (verbose)
-								dump_hex (data, len);
-						break;
-				}
-				case 0x016d: /* SSE */
-						skip = 3;
-						break;
-
-				case 0x0c10: /* SSE */
-				case 0x0c41: /* SSE */
-				case 0x0141:
-				case 0x0e41:
-						fprintf (stderr, "0x%x\n", code);
-						break;
-				case 0x01f6:
-						fprintf (stderr, "0x%x\n", code);
-						skip = 3;
-						break;
-				case 0x0196: { // embedded @ somehow
-						skip = 3;
-						break;
-				}
-				case 0x8202:
-						fprintf (stderr, "CRLF?\n");
-						skip = 2;
-						break;
-				case 0xc301:
-						fprintf (stderr, "0x%x\n", code);
-						skip = 4;
-						break;
-				default: {
-						fprintf (stderr, "Unknown code 0x%x\n", code);
-						fseek (fin, -2, SEEK_CUR);
-						skip_to_at (fin, 0x20, 1);
-						end_of_run = 1;
-						break;
-				}
-				}
-				if (skip)
-						fseek (fin, skip, SEEK_CUR);
-		}
-}
-
-int
-main (int argc, char **argv)
-{
-	int i;
-	const char *fname = NULL;
-	FILE *fin;
-
-	for (i = 1; i < argc; i++)
-	{
-			if (argv[i][0] == '-' &&
-				argv[i][1] == 'v')
-					verbose = 1;
-			else if (!fname)
-					fname = argv[i];
-	}
-
-	fin = fopen (fname, "r");
-	fseek (fin, init_offset, SEEK_SET);
-	
-	while (!feof (fin)) {
-		unsigned char code;
-		code = my_fgetc (fin);
-		switch (code) {
-		case 0x20:
-				code = my_fgetc (fin);
-				if (code == 0x40)
-						fprintf (stderr, "2040\n");
-				else {
-						ungetc (code, fin);
-						scan_text (fin);
-				}
-				break;
-		default: {
-				skip_to_at (fin, code, verbose);
-				break;
-		}
-		}
-	}
-
-	fclose (fin);
-
-	return 0;
-} 
diff --git a/test/Lwp/lwp1.lwp b/test/Lwp/lwp1.lwp
deleted file mode 100644
index 35d863156..000000000
--- a/test/Lwp/lwp1.lwp
+++ /dev/null
diff --git a/test/Lwp/lwp1.txt b/test/Lwp/lwp1.txt
deleted file mode 100644
index d99bd059f..000000000
--- a/test/Lwp/lwp1.txt
+++ /dev/null
@@ -1 +0,0 @@
-Hello this is a test file
diff --git a/test/Lwp/lwp2.c b/test/Lwp/lwp2.c
deleted file mode 100644
index c067a277b..000000000
--- a/test/Lwp/lwp2.c
+++ /dev/null
@@ -1,84 +0,0 @@
-#include <stdio.h>
-#include <malloc.h>
-#include <ctype.h>
-
-static FILE *in;
-
-typedef unsigned char byte_t;
-
-static long init_offset = 0x68;
-
-static void
-print_indent (int indent)
-{
-  int i;
-  for (i = 0; i < indent; i++)
-    fprintf( stderr, "  " );
-}  
-
-static void
-dump_hex (unsigned char *data, int len, int indent)
-{
-  while (len > 0) {
-    int chunk = len < 16 ? len : 16;
-    int i;
-		
-    print_indent (indent);
-    for (i = 0; i < chunk; i++)
-      fprintf( stderr, "%.2x ", data[i] );
-    fprintf( stderr, "| " );
-    for (i = 0; i < chunk; i++)
-      fprintf( stderr, "%c", data[i] < 127 && data[i] > 30 ? data[i] : '.' );
-    fprintf( stderr, "\n" );
-
-    len -= chunk;
-    data += 16;
-  }
-}
-
-static void
-dump_at (FILE *in)
-{
-  int i = 0;
-  byte_t frame = 0x01;
-  byte_t data[65536] = { 0, };
-  byte_t last = 0;
-  int indent = 0;
-
-  while (!feof(in)) {
-    data[i] = fgetc (in);
-    if (data[i] == '@') {
-      fprintf( stderr, "Field length 0x%x\n", i );
-      dump_hex (data, i, 0);
-      data[0] = data[i];
-      i = 0;
-    }
-    i++;
-  }
-}
-
-int
-main (int argc, char **argv)
-{
-  int i = 0;
-  byte_t frame = 0x01;
-  byte_t data[655360] = { 0, };
-
-  in = fopen(argv[1], "r");
-
-  if (argc > 2)
-    init_offset = atoi (argv[2]);
-
-  fseek (in, init_offset, SEEK_SET);
-
-  while (!feof (in)) {
-    byte_t t = fgetc (in);
-    if (t < 8) {
-      dump_hex (data, i, data[0]);
-      i = 0;
-    }
-    data[i++] = t;
-  }
-  fclose (in);
-  return 0;
-} 
diff --git a/test/calc/autofilter_multistring_extension.ods b/test/calc/autofilter_multistring_extension.ods
deleted file mode 100644
index 359d9eee3..000000000
--- a/test/calc/autofilter_multistring_extension.ods
+++ /dev/null
diff --git a/test/calc/intPrecisionTest.ods b/test/calc/intPrecisionTest.ods
deleted file mode 100644
index 1e08acffe..000000000
--- a/test/calc/intPrecisionTest.ods
+++ /dev/null
diff --git a/test/calc/macros.xls b/test/calc/macros.xls
deleted file mode 100644
index 7348282c7..000000000
--- a/test/calc/macros.xls
+++ /dev/null
diff --git a/test/calc/optional.xls b/test/calc/optional.xls
deleted file mode 100644
index cb5c6385d..000000000
--- a/test/calc/optional.xls
+++ /dev/null
diff --git a/test/calc/problems.xls b/test/calc/problems.xls
deleted file mode 100644
index 375ad6c45..000000000
--- a/test/calc/problems.xls
+++ /dev/null
diff --git a/test/csv/README b/test/csv/README
deleted file mode 100644
index db30bcb31..000000000
--- a/test/csv/README
+++ /dev/null
@@ -1,52 +0,0 @@
-= CSV Import Test Instructions =
-
-== Test Documents Naming Convention ==
-
-There are two types of csv test files included in this directory.  The ones 
-prefixed by "space_" are space-separated csv files, while those prefixed by 
-"fixed_" are fixed width csv's.  
-
-The files contain three types of number formats: 1-1 (num_dash_num), 1.1 
-(num_dot_num) and 1,1 (num_comma_num).  Also, the ones ending with "_quoted" 
-have their values quoted.  
-
-== When Importing Each File == 
-
-Import each file with and without the "Quoted field as text" option, and with 
-and without "Detect special numbers" option.  Also import using at minimum, 
-'English (USA)' and 'French (France)' as the Language.  
-
-== Importing Fixed Width CSV with Quoted Values ==
-
-When importing a fixed-width CSV file with quoted values, set the "Separator 
-options" to "Fixed width", and set partitions between the quoted values.
-
-== Importing Space-Separated CSV ==
-
-Set the "Separator options" to "Separated by", and check "Space" check box and 
-"Text delimiter" to '"' (double quote).  
-
-== Language ==
-
-Selecting different languages affects how thousands separators and decimal 
-separators are interpreted.  For example, selecting 'French (France)' expects 
-a valid number to be formatted as "123 456,789" whereas in 'English (USA)' the 
-same number is expressed as "123,456.789".  In 'English (USA)', the thousands 
-and decimal separators are ',' and '.' respectively, while in 'French 
-(France)' they are ' ' and ',', respectively.  
-
-== Quoted Field as Text ==
-
-When this option is checked, any quoted value (such as "1.34") is imported as 
-text, without automatic conversion to numeric value.  Since all texts 
-internally carry a value of 0, performing arithmetic on such value always 
-yields zero.  That's one way to test whether a cell has a text or a number.  
-Also, using ISTEXT or ISNUMBER cell function is helpful in determining whether 
-the value is text or number.  
-
-== Detect Special Numbers ==
-
-With this option checked, Calc tries to detect special numbers such as dates, 
-scientific notations etc.  For instance, a value such as 1-1 will be converted 
-to date using 'English (USA)' as the language, and a value such as 1.1 will be 
-converted to date using 'French (France)', and so on.  
diff --git a/test/csv/fixed_num_comma_num_quoted.csv b/test/csv/fixed_num_comma_num_quoted.csv
deleted file mode 100644
index ef04ccba4..000000000
--- a/test/csv/fixed_num_comma_num_quoted.csv
+++ /dev/null
@@ -1,10 +0,0 @@
-"0,0""0,1""0,2""0,3""0,4""0,5""0,6""0,7""0,8""0,9"
-"1,0""1,1""1,2""1,3""1,4""1,5""1,6""1,7""1,8""1,9"
-"2,0""2,1""2,2""2,3""2,4""2,5""2,6""2,7""2,8""2,9"
-"3,0""3,1""3,2""3,3""3,4""3,5""3,6""3,7""3,8""3,9"
-"4,0""4,1""4,2""4,3""4,4""4,5""4,6""4,7""4,8""4,9"
-"5,0""5,1""5,2""5,3""5,4""5,5""5,6""5,7""5,8""5,9"
-"6,0""6,1""6,2""6,3""6,4""6,5""6,6""6,7""6,8""6,9"
-"7,0""7,1""7,2""7,3""7,4""7,5""7,6""7,7""7,8""7,9"
-"8,0""8,1""8,2""8,3""8,4""8,5""8,6""8,7""8,8""8,9"
-"9,0""9,1""9,2""9,3""9,4""9,5""9,6""9,7""9,8""9,9"
diff --git a/test/csv/fixed_num_dash_num_quoted.csv b/test/csv/fixed_num_dash_num_quoted.csv
deleted file mode 100644
index 47b1050c0..000000000
--- a/test/csv/fixed_num_dash_num_quoted.csv
+++ /dev/null
@@ -1,10 +0,0 @@
-"0-0""0-1""0-2""0-3""0-4""0-5""0-6""0-7""0-8""0-9"
-"1-0""1-1""1-2""1-3""1-4""1-5""1-6""1-7""1-8""1-9"
-"2-0""2-1""2-2""2-3""2-4""2-5""2-6""2-7""2-8""2-9"
-"3-0""3-1""3-2""3-3""3-4""3-5""3-6""3-7""3-8""3-9"
-"4-0""4-1""4-2""4-3""4-4""4-5""4-6""4-7""4-8""4-9"
-"5-0""5-1""5-2""5-3""5-4""5-5""5-6""5-7""5-8""5-9"
-"6-0""6-1""6-2""6-3""6-4""6-5""6-6""6-7""6-8""6-9"
-"7-0""7-1""7-2""7-3""7-4""7-5""7-6""7-7""7-8""7-9"
-"8-0""8-1""8-2""8-3""8-4""8-5""8-6""8-7""8-8""8-9"
-"9-0""9-1""9-2""9-3""9-4""9-5""9-6""9-7""9-8""9-9"
diff --git a/test/csv/fixed_num_dot_num_quoted.csv b/test/csv/fixed_num_dot_num_quoted.csv
deleted file mode 100644
index 80775f7e4..000000000
--- a/test/csv/fixed_num_dot_num_quoted.csv
+++ /dev/null
@@ -1,10 +0,0 @@
-"0.0""0.1""0.2""0.3""0.4""0.5""0.6""0.7""0.8""0.9"
-"1.0""1.1""1.2""1.3""1.4""1.5""1.6""1.7""1.8""1.9"
-"2.0""2.1""2.2""2.3""2.4""2.5""2.6""2.7""2.8""2.9"
-"3.0""3.1""3.2""3.3""3.4""3.5""3.6""3.7""3.8""3.9"
-"4.0""4.1""4.2""4.3""4.4""4.5""4.6""4.7""4.8""4.9"
-"5.0""5.1""5.2""5.3""5.4""5.5""5.6""5.7""5.8""5.9"
-"6.0""6.1""6.2""6.3""6.4""6.5""6.6""6.7""6.8""6.9"
-"7.0""7.1""7.2""7.3""7.4""7.5""7.6""7.7""7.8""7.9"
-"8.0""8.1""8.2""8.3""8.4""8.5""8.6""8.7""8.8""8.9"
-"9.0""9.1""9.2""9.3""9.4""9.5""9.6""9.7""9.8""9.9"
diff --git a/test/csv/space_num_comma_num.csv b/test/csv/space_num_comma_num.csv
deleted file mode 100644
index 976874cfd..000000000
--- a/test/csv/space_num_comma_num.csv
+++ /dev/null
@@ -1,10 +0,0 @@
-0,0 0,1 0,2 0,3 0,4 0,5 0,6 0,7 0,8 0,9
-1,0 1,1 1,2 1,3 1,4 1,5 1,6 1,7 1,8 1,9
-2,0 2,1 2,2 2,3 2,4 2,5 2,6 2,7 2,8 2,9
-3,0 3,1 3,2 3,3 3,4 3,5 3,6 3,7 3,8 3,9
-4,0 4,1 4,2 4,3 4,4 4,5 4,6 4,7 4,8 4,9
-5,0 5,1 5,2 5,3 5,4 5,5 5,6 5,7 5,8 5,9
-6,0 6,1 6,2 6,3 6,4 6,5 6,6 6,7 6,8 6,9
-7,0 7,1 7,2 7,3 7,4 7,5 7,6 7,7 7,8 7,9
-8,0 8,1 8,2 8,3 8,4 8,5 8,6 8,7 8,8 8,9
-9,0 9,1 9,2 9,3 9,4 9,5 9,6 9,7 9,8 9,9
diff --git a/test/csv/space_num_comma_num_quoted.csv b/test/csv/space_num_comma_num_quoted.csv
deleted file mode 100644
index aa579beea..000000000
--- a/test/csv/space_num_comma_num_quoted.csv
+++ /dev/null
@@ -1,10 +0,0 @@
-"0,0" "0,1" "0,2" "0,3" "0,4" "0,5" "0,6" "0,7" "0,8" "0,9"
-"1,0" "1,1" "1,2" "1,3" "1,4" "1,5" "1,6" "1,7" "1,8" "1,9"
-"2,0" "2,1" "2,2" "2,3" "2,4" "2,5" "2,6" "2,7" "2,8" "2,9"
-"3,0" "3,1" "3,2" "3,3" "3,4" "3,5" "3,6" "3,7" "3,8" "3,9"
-"4,0" "4,1" "4,2" "4,3" "4,4" "4,5" "4,6" "4,7" "4,8" "4,9"
-"5,0" "5,1" "5,2" "5,3" "5,4" "5,5" "5,6" "5,7" "5,8" "5,9"
-"6,0" "6,1" "6,2" "6,3" "6,4" "6,5" "6,6" "6,7" "6,8" "6,9"
-"7,0" "7,1" "7,2" "7,3" "7,4" "7,5" "7,6" "7,7" "7,8" "7,9"
-"8,0" "8,1" "8,2" "8,3" "8,4" "8,5" "8,6" "8,7" "8,8" "8,9"
-"9,0" "9,1" "9,2" "9,3" "9,4" "9,5" "9,6" "9,7" "9,8" "9,9"
diff --git a/test/csv/space_num_dash_num.csv b/test/csv/space_num_dash_num.csv
deleted file mode 100644
index 6846c9d93..000000000
--- a/test/csv/space_num_dash_num.csv
+++ /dev/null
@@ -1,10 +0,0 @@
-0-0 0-1 0-2 0-3 0-4 0-5 0-6 0-7 0-8 0-9
-1-0 1-1 1-2 1-3 1-4 1-5 1-6 1-7 1-8 1-9
-2-0 2-1 2-2 2-3 2-4 2-5 2-6 2-7 2-8 2-9
-3-0 3-1 3-2 3-3 3-4 3-5 3-6 3-7 3-8 3-9
-4-0 4-1 4-2 4-3 4-4 4-5 4-6 4-7 4-8 4-9
-5-0 5-1 5-2 5-3 5-4 5-5 5-6 5-7 5-8 5-9
-6-0 6-1 6-2 6-3 6-4 6-5 6-6 6-7 6-8 6-9
-7-0 7-1 7-2 7-3 7-4 7-5 7-6 7-7 7-8 7-9
-8-0 8-1 8-2 8-3 8-4 8-5 8-6 8-7 8-8 8-9
-9-0 9-1 9-2 9-3 9-4 9-5 9-6 9-7 9-8 9-9
diff --git a/test/csv/space_num_dash_num_quoted.csv b/test/csv/space_num_dash_num_quoted.csv
deleted file mode 100644
index bc07a9c5b..000000000
--- a/test/csv/space_num_dash_num_quoted.csv
+++ /dev/null
@@ -1,10 +0,0 @@
-"0-0" "0-1" "0-2" "0-3" "0-4" "0-5" "0-6" "0-7" "0-8" "0-9"
-"1-0" "1-1" "1-2" "1-3" "1-4" "1-5" "1-6" "1-7" "1-8" "1-9"
-"2-0" "2-1" "2-2" "2-3" "2-4" "2-5" "2-6" "2-7" "2-8" "2-9"
-"3-0" "3-1" "3-2" "3-3" "3-4" "3-5" "3-6" "3-7" "3-8" "3-9"
-"4-0" "4-1" "4-2" "4-3" "4-4" "4-5" "4-6" "4-7" "4-8" "4-9"
-"5-0" "5-1" "5-2" "5-3" "5-4" "5-5" "5-6" "5-7" "5-8" "5-9"
-"6-0" "6-1" "6-2" "6-3" "6-4" "6-5" "6-6" "6-7" "6-8" "6-9"
-"7-0" "7-1" "7-2" "7-3" "7-4" "7-5" "7-6" "7-7" "7-8" "7-9"
-"8-0" "8-1" "8-2" "8-3" "8-4" "8-5" "8-6" "8-7" "8-8" "8-9"
-"9-0" "9-1" "9-2" "9-3" "9-4" "9-5" "9-6" "9-7" "9-8" "9-9"
diff --git a/test/csv/space_num_dot_num.csv b/test/csv/space_num_dot_num.csv
deleted file mode 100644
index 05672b8d4..000000000
--- a/test/csv/space_num_dot_num.csv
+++ /dev/null
@@ -1,10 +0,0 @@
-0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9
-1.0 1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 1.9
-2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9
-3.0 3.1 3.2 3.3 3.4 3.5 3.6 3.7 3.8 3.9
-4.0 4.1 4.2 4.3 4.4 4.5 4.6 4.7 4.8 4.9
-5.0 5.1 5.2 5.3 5.4 5.5 5.6 5.7 5.8 5.9
-6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9
-7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9
-8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9
-9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9
diff --git a/test/csv/space_num_dot_num_quoted.csv b/test/csv/space_num_dot_num_quoted.csv
deleted file mode 100644
index ad9942436..000000000
--- a/test/csv/space_num_dot_num_quoted.csv
+++ /dev/null
@@ -1,10 +0,0 @@
-"0.0" "0.1" "0.2" "0.3" "0.4" "0.5" "0.6" "0.7" "0.8" "0.9"
-"1.0" "1.1" "1.2" "1.3" "1.4" "1.5" "1.6" "1.7" "1.8" "1.9"
-"2.0" "2.1" "2.2" "2.3" "2.4" "2.5" "2.6" "2.7" "2.8" "2.9"
-"3.0" "3.1" "3.2" "3.3" "3.4" "3.5" "3.6" "3.7" "3.8" "3.9"
-"4.0" "4.1" "4.2" "4.3" "4.4" "4.5" "4.6" "4.7" "4.8" "4.9"
-"5.0" "5.1" "5.2" "5.3" "5.4" "5.5" "5.6" "5.7" "5.8" "5.9"
-"6.0" "6.1" "6.2" "6.3" "6.4" "6.5" "6.6" "6.7" "6.8" "6.9"
-"7.0" "7.1" "7.2" "7.3" "7.4" "7.5" "7.6" "7.7" "7.8" "7.9"
-"8.0" "8.1" "8.2" "8.3" "8.4" "8.5" "8.6" "8.7" "8.8" "8.9"
-"9.0" "9.1" "9.2" "9.3" "9.4" "9.5" "9.6" "9.7" "9.8" "9.9"
diff --git a/test/draw/alltransitions.odp b/test/draw/alltransitions.odp
deleted file mode 100644
index 3ccc3115c..000000000
--- a/test/draw/alltransitions.odp
+++ /dev/null
diff --git a/test/draw/bullet-chars.ppt b/test/draw/bullet-chars.ppt
deleted file mode 100644
index deebc62f0..000000000
--- a/test/draw/bullet-chars.ppt
+++ /dev/null
diff --git a/test/draw/bullets.ppt b/test/draw/bullets.ppt
deleted file mode 100644
index 18348ed62..000000000
--- a/test/draw/bullets.ppt
+++ /dev/null
diff --git a/test/draw/fill.odp b/test/draw/fill.odp
deleted file mode 100644
index f6188cd7b..000000000
--- a/test/draw/fill.odp
+++ /dev/null
diff --git a/test/draw/polygon-tests.sxd b/test/draw/polygon-tests.sxd
deleted file mode 100644
index e9c30f901..000000000
--- a/test/draw/polygon-tests.sxd
+++ /dev/null
diff --git a/test/excel/autoFilter.xlsx b/test/excel/autoFilter.xlsx
deleted file mode 100644
index 56e90f027..000000000
--- a/test/excel/autoFilter.xlsx
+++ /dev/null
diff --git a/test/excel/autoFilterLarge.xls b/test/excel/autoFilterLarge.xls
deleted file mode 100644
index ac780ad92..000000000
--- a/test/excel/autoFilterLarge.xls
+++ /dev/null
diff --git a/test/excel/autoFilterLarge.xlsx b/test/excel/autoFilterLarge.xlsx
deleted file mode 100644
index 7698c8101..000000000
--- a/test/excel/autoFilterLarge.xlsx
+++ /dev/null
diff --git a/test/excel/break1.xlsx b/test/excel/break1.xlsx
deleted file mode 100644
index 7d023671e..000000000
--- a/test/excel/break1.xlsx
+++ /dev/null
diff --git a/test/excel/condFormat.xlsx b/test/excel/condFormat.xlsx
deleted file mode 100644
index 3abc44efc..000000000
--- a/test/excel/condFormat.xlsx
+++ /dev/null
diff --git a/test/excel/dataValidation.xlsx b/test/excel/dataValidation.xlsx
deleted file mode 100644
index 218134a93..000000000
--- a/test/excel/dataValidation.xlsx
+++ /dev/null
diff --git a/test/excel/definedNames.xlsx b/test/excel/definedNames.xlsx
deleted file mode 100644
index 596c55897..000000000
--- a/test/excel/definedNames.xlsx
+++ /dev/null
diff --git a/test/excel/extSheet.xlsx b/test/excel/extSheet.xlsx
deleted file mode 100644
index 33b182fa9..000000000
--- a/test/excel/extSheet.xlsx
+++ /dev/null
diff --git a/test/excel/extSheetContent.xlsx b/test/excel/extSheetContent.xlsx
deleted file mode 100644
index 6e921830d..000000000
--- a/test/excel/extSheetContent.xlsx
+++ /dev/null
diff --git a/test/excel/extSheetContent2.xlsx b/test/excel/extSheetContent2.xlsx
deleted file mode 100644
index a490aa5db..000000000
--- a/test/excel/extSheetContent2.xlsx
+++ /dev/null
diff --git a/test/excel/formulaFrequency.xls b/test/excel/formulaFrequency.xls
deleted file mode 100644
index 73996d6c3..000000000
--- a/test/excel/formulaFrequency.xls
+++ /dev/null
diff --git a/test/excel/gen1.xlsx b/test/excel/gen1.xlsx
deleted file mode 100644
index 502f4fd42..000000000
--- a/test/excel/gen1.xlsx
+++ /dev/null
diff --git a/test/excel/hyperLink.xls b/test/excel/hyperLink.xls
deleted file mode 100644
index dc8a7b3ba..000000000
--- a/test/excel/hyperLink.xls
+++ /dev/null
diff --git a/test/excel/hyperLink.xlsx b/test/excel/hyperLink.xlsx
deleted file mode 100644
index b4fbd1c1f..000000000
--- a/test/excel/hyperLink.xlsx
+++ /dev/null
diff --git a/test/excel/linkedDoc.xlsx b/test/excel/linkedDoc.xlsx
deleted file mode 100644
index cb3848bca..000000000
--- a/test/excel/linkedDoc.xlsx
+++ /dev/null
diff --git a/test/excel/perf/chart_large_data.xls.bz2 b/test/excel/perf/chart_large_data.xls.bz2
deleted file mode 100644
index 5dab95b57..000000000
--- a/test/excel/perf/chart_large_data.xls.bz2
+++ /dev/null
diff --git a/test/excel/perf/search_function_slowness_on_import.xls.bz2 b/test/excel/perf/search_function_slowness_on_import.xls.bz2
deleted file mode 100644
index 5fb8e1a3b..000000000
--- a/test/excel/perf/search_function_slowness_on_import.xls.bz2
+++ /dev/null
diff --git a/test/excel/phoneticGuide.xlsx b/test/excel/phoneticGuide.xlsx
deleted file mode 100644
index d3560ad96..000000000
--- a/test/excel/phoneticGuide.xlsx
+++ /dev/null
diff --git a/test/excel/pivotTable.xlsx b/test/excel/pivotTable.xlsx
deleted file mode 100644
index 817a91c4a..000000000
--- a/test/excel/pivotTable.xlsx
+++ /dev/null
diff --git a/test/excel/textNumberTest.xls b/test/excel/textNumberTest.xls
deleted file mode 100644
index cedd50033..000000000
--- a/test/excel/textNumberTest.xls
+++ /dev/null
diff --git a/test/excel/themedColor.xlsx b/test/excel/themedColor.xlsx
deleted file mode 100644
index 5b46b8f72..000000000
--- a/test/excel/themedColor.xlsx
+++ /dev/null
diff --git a/test/excel/webQuery.xls b/test/excel/webQuery.xls
deleted file mode 100644
index 0c714e802..000000000
--- a/test/excel/webQuery.xls
+++ /dev/null
diff --git a/test/excel/webQuery.xlsx b/test/excel/webQuery.xlsx
deleted file mode 100644
index b8e73a7d4..000000000
--- a/test/excel/webQuery.xlsx
+++ /dev/null
diff --git a/test/lotus/TextAttr.123 b/test/lotus/TextAttr.123
deleted file mode 100644
index 763b0573a..000000000
--- a/test/lotus/TextAttr.123
+++ /dev/null
diff --git a/test/lotus/attribute-9.7.123 b/test/lotus/attribute-9.7.123
deleted file mode 100644
index b159d78ae..000000000
--- a/test/lotus/attribute-9.7.123
+++ /dev/null
diff --git a/test/lotus/lotus.c b/test/lotus/lotus.c
deleted file mode 100644
index 4507518be..000000000
--- a/test/lotus/lotus.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/// To run: gcc lotus.c && ./a.out TextAttr.123 2>&1 | less
-
-#include <stdio.h>
-#include <malloc.h>
-#include <ctype.h>
-
-static FILE *in;
-typedef unsigned char byte_t;
-
-static void
-print_indent (int indent)
-{
-		int i;
-		for (i = 0; i < indent; i++)
-				fprintf( stderr, "  " );
-}  
-
-static void
-dump_hex (unsigned char *data, int len, int indent)
-{
-	while (len > 0) {
-		int chunk = len < 16 ? len : 16;
-		int i;
-		
-		print_indent (indent);
-		for (i = 0; i < chunk; i++)
-			fprintf( stderr, "%.2x ", data[i] );
-		fprintf( stderr, "| " );
-		for (i = 0; i < chunk; i++)
-			fprintf( stderr, "%c", data[i] < 127 && data[i] > 30 ? data[i] : '.' );
-		fprintf( stderr, "\n" );
-
-		len -= chunk;
-		data += 16;
-	}
-}
-
-int
-main (int argc, char **argv)
-{
-		byte_t data[65550] = { 0, };
-		int indent = 0;
-
-		in = fopen(argv[1], "r");
-		fseek (in, 0, SEEK_SET);
-		while (!feof(in)) {
-				unsigned short nOp = 0;
-				unsigned short nLength = 0;
-
-				fread( data, 1, 4, in );
-				nOp = data[0] + (data[1] << 8);
-				nLength = data[2] + (data[3] << 8);
-
-				if (nOp == 0x107)
-						indent-=2;
-				print_indent (indent);
-				if (nOp == 0x106)
-						indent+=2;
-
-				fprintf( stderr, "Op 0x%x, length 0x%x\n", nOp, nLength );
-				fread( data, 1, nLength, in);
-				dump_hex( data, nLength, indent + 1 );
-		}
-		fclose (in);
-		return 0;
-} 
diff --git a/test/lotus/numbers.123 b/test/lotus/numbers.123
deleted file mode 100644
index b967e6458..000000000
--- a/test/lotus/numbers.123
+++ /dev/null
diff --git a/test/lotus/test_sample.123 b/test/lotus/test_sample.123
deleted file mode 100644
index 24ba3e886..000000000
--- a/test/lotus/test_sample.123
+++ /dev/null
diff --git a/test/lotus/testfile-123.123 b/test/lotus/testfile-123.123
deleted file mode 100644
index 77cb0f39f..000000000
--- a/test/lotus/testfile-123.123
+++ /dev/null
diff --git a/test/lotus/testfile-me.123 b/test/lotus/testfile-me.123
deleted file mode 100644
index c7dd3fa72..000000000
--- a/test/lotus/testfile-me.123
+++ /dev/null
diff --git a/test/macro/AutoFillTest.xls b/test/macro/AutoFillTest.xls
deleted file mode 100644
index bbdbf444f..000000000
--- a/test/macro/AutoFillTest.xls
+++ /dev/null
diff --git a/test/macro/ConstCheck.xls b/test/macro/ConstCheck.xls
deleted file mode 100644
index cf21146cc..000000000
--- a/test/macro/ConstCheck.xls
+++ /dev/null
diff --git a/test/macro/ConvertTests/ChartAxes-oovbaapi.xls b/test/macro/ConvertTests/ChartAxes-oovbaapi.xls
deleted file mode 100644
index d11200630..000000000
--- a/test/macro/ConvertTests/ChartAxes-oovbaapi.xls
+++ /dev/null
diff --git a/test/macro/ConvertTests/ChartAxes.xls b/test/macro/ConvertTests/ChartAxes.xls
deleted file mode 100644
index c3c07fde7..000000000
--- a/test/macro/ConvertTests/ChartAxes.xls
+++ /dev/null
diff --git a/test/macro/ConvertTests/MigrateFromHelperApiTests.txt b/test/macro/ConvertTests/MigrateFromHelperApiTests.txt
deleted file mode 100644
index 3d56228dd..000000000
--- a/test/macro/ConvertTests/MigrateFromHelperApiTests.txt
+++ /dev/null
@@ -1,48 +0,0 @@
-Converting the test documents to vba interop api.
-=================================================
-
-Converting the helperapi test documents. To convert one of the helperapi test documents please follow the following manual tests
-
-1) replace the TestLogMacros module in the document with the new TestLogMacros ( remove the one in the document and import the .bas file )
-
-
-please note: the steps below are no longer necessary: noelp Sep, 07
-
-===== n o  n e e d  t o  d o  t h i s  a n y m o r e  ============
-
-2) next we need to convert the other modules, first click on the module to convert, right click and select Remove 'Module', select the export option
-
-3) call tweakModule 'Module'
-
-4) import converted 'Module' back into document
-
-o background
-    TestLogMacros.bas - is a replacement for the excel version of TestLogMacros modules that exists in the test documents.  This main difference is that the logfile location is determined either from a hardcoded path ( 'c:\HelperApi-vba.log' ) or the default document location e.g. ~/Documents/HelperApi-vba.log' ) depending on whether the macro is run from openoffice or excel
-
-2) convert the test macros in in test document.
-
-
-ChartAxes.xls - an example of the original test cases
-
-ChartAxes-oovbaapi.xls - the testcases converted so that they will run with the vba interop solution ( openoffice ) 
-
-   main changes you generally need to make are to cater for optional parameters e.g. such as the function  
-
-   Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
-
-The helperapi test documents located in api/helperapi/test_documents/*.idl call this methods in the following way
-
-TestLog_ASSERT (bSuccessful = True), "Chart successfully selected"
-
-but this calling convention this generates compile errors in openoffice...
-
-the following variant will also fail to compile in excel
- 
-TestLog_ASSERT( (bSuccessful = True), "Chart successfully selected" )
-
-but... the following will work both in openoffice and excel
-
-Call TestLog_ASSERT( (bSuccessful = True), "Chart successfully selected" )
-
-so the tweakxxxx script(s) change the calling convertion to something that works in both openoffice and excel
-
diff --git a/test/macro/ConvertTests/TestLogMacros.bas b/test/macro/ConvertTests/TestLogMacros.bas
deleted file mode 100644
index 4cafc8e61..000000000
--- a/test/macro/ConvertTests/TestLogMacros.bas
+++ /dev/null
@@ -1,218 +0,0 @@
-Attribute VB_Name = "TestLogMacros"
-' { Declarations shared with MS Office API tests
-
-Global Const FILE_EXT_DOC = "odt"
-Global Const FILE_EXT_XLS = "ods"
-Global Const FILE_EXT_PPT = "odp"
-Global Const FILE_EXT_VIS = "odg"
-
-Private theCalcApplication As Object
-' Global vbExternalCall As Long
-
-Global PARAGRAPH_END As String
-Global Const DIR_SEPARATOR As String = "\"
-
-' } Declarations shared with MS Office API tests
-
-' BEGIN: *** { TEST API (PortableHelperAPITest)
-
-Private HELPER_TEST_LOG As String
-
-Private TestLog_FileNo As Integer
-Private TestLog_LastTest As String
-Private TestLog_LastTestResult As Boolean
-
-Private TESTLOG_VERBOSE As Boolean
-
-Function isOpenoffice() As Boolean
-On Error GoTo notopenoffice
-Dim a As Variant
-a = CreateObject("com.sun.star.beans.PropertyValue")
-isOpenoffice = True
-Exit Function
-notopenoffice:
-isOpenoffice = False
-End Function
-Function TestAreEqual(x1 As Variant, x2 As Variant) As Boolean
-    If x1 = x2 Then
-        TestAreEqual = True
-    Else
-        TestAreEqual = False
-    End If
-End Function
-
-Function TestNotEqual(x1 As Variant, x2 As Variant) As Boolean
-    If Not (x1 = x2) Then
-        TestNotEqual = True
-    Else
-        TestNotEqual = False
-    End If
-End Function
-
-Sub TestLog_SetFileName(filename As String)
-    Dim tmp As String
-    tmp = HELPER_TEST_LOG
-    HELPER_TEST_LOG = filename
-    If Not (TestLog_FileNo = 0) Then
-        TestLog_Comment "Closing log, future log output going to " + filename
-        TestLog_Close
-        TestLog_Comment "Reopening log, previous log output went to " + tmp
-    End If
-End Sub
-
-Sub TestLog_Comment(comment As String)
-    If (TestLog_FileNo = 0) Then
-        TestLog_FileNo = FreeFile ' Establish free file handle
-        If (HELPER_TEST_LOG = "") Then
-            HELPER_TEST_LOG = DefaultLog
-        End If
-        Open HELPER_TEST_LOG For Output As #TestLog_FileNo
-    End If
-    Print #TestLog_FileNo, comment
-End Sub
-Function OpenofficeLog() As String
-         Dim PathSettings As Object
-         Dim WorkingDirectory As String
-        PathSettings = createUnoService("com.sun.star.comp.framework.PathSettings")
-        WorkingDirectory = PathSettings.Work
-        OpenofficeLog = WorkingDirectory + "/" + "HelperAPI-test.log"
-        End Function
-Function DefaultLog() As String
-If isOpenoffice Then
-    DefaultLog = OpenofficeLog
-Else
-    DefaultLog = "c:\HelperApi-vba.log"
-End If
-
-End Function
-
-Sub TestLog_BEGIN(testName As String)
-    If Not (TestLog_LastTest = "") Then
-        Print #TestLog_FileNo, TestLog_LastTest + " NOT COMPLETE"
-    End If
-    TestLog_LastTest = testName
-    TestLog_LastTestResult = True
-    
-    Dim s As String
-    If TESTLOG_VERBOSE Then
-        s = " TEST START : " + testName
-        TestLog_Comment s
-    End If
-End Sub
-
-Sub TestLog_END(testResult As String, testName As String, Optional testComment As String)
-    If (TestLog_LastTest = "") Then
-        TestLog_Comment "TEST ERROR - no test begun: " + testName
-    Else
-        If Not (TestLog_LastTest = testName) Then
-            TestLog_Comment "TEST ERROR - found test end: " + testName + " , expecting test end " + TestLog_LastTest
-        Else
-            Dim s As String
-            s = " TEST " + testResult + " : " + testName
-            If TESTLOG_VERBOSE And Not IsMissing(testComment) And Not (testComment = "") Then
-                s = s + " (" + testComment + ")."
-            End If
-            TestLog_Comment s
-        End If
-    End If
-    TestLog_LastTest = ""
-End Sub
-
-Sub TestLog_ITEM(testComment As String)
-    If (TestLog_LastTest = "") Then
-        TestLog_Comment "TEST ERROR - no test begun: " + testComment
-    Else
-        TestLog_Comment "  ITEM " + testComment
-    End If
-End Sub
-
-Sub TestLog_FAIL(testName As String, Optional testComment As String)
-    If IsMissing(testComment) Then
-        TestLog_END "FAIL", testName
-    Else
-        TestLog_END "FAIL", testName, testComment
-    End If
-End Sub
-
-Sub TestLog_OK(testName As String, Optional testComment As String)
-    If IsMissing(testComment) Then
-        TestLog_END "OK", testName
-    Else
-        TestLog_END "OK", testName, testComment
-    End If
-End Sub
-
- Sub TestLog_PartComment(status As String, Optional testComment As String)
-     If IsMissing(testComment) Then
-         testComment = status
-     Else
-         testComment = status + " (" + testComment + ")"
-     End If
-     TestLog_ITEM testComment
- End Sub
-
- Sub TestLog_PartFAIL(Optional testComment As String)
-     TestLog_LastTestResult = False
-     TestLog_PartComment "FAIL", testComment
- End Sub
-
- Sub TestLog_PartOK(Optional testComment As String)
-     TestLog_PartComment "OK", testComment
- End Sub
-
-Sub TestLog_ASSERTSetVerbose(verbose As Boolean)
-    TESTLOG_VERBOSE = verbose
-End Sub
-
-Function TestLog_ASSERTGetVerbose() As Boolean
-    TestLog_ASSERTGetVerbose = TESTLOG_VERBOSE
-End Function
-
-Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
-    Dim testMsg As String
-    testMsg = "Assertion "
-    If assertion = True Then
-        testMsg = testMsg + "OK"
-    Else
-        TestLog_LastTestResult = False
-        testMsg = testMsg + "FAIL"
-    End If
-    If Not IsMissing(testId) Then
-        testMsg = testMsg + " : " + testId
-    End If
-    If TESTLOG_VERBOSE And Not IsMissing(testComment) And Not (testComment = "") Then
-        testMsg = testMsg + " (" + testComment + ")"
-    End If
-    If assertion = False Or TESTLOG_VERBOSE Then
-        TestLog_ITEM testMsg
-    End If
-End Sub
-
-Sub TestLog_SUMMARY(testName As String, Optional testComment As String)
-    ' SBA does not preserve "optional" status of a parameter; it is evaluated then passed,
-    ' even if the called routine (e.g. TestLog_OK) *also* has considers the parameter to be optional.
-    If IsMissing(testComment) Or testComment = "" Then
-        If TestLog_LastTestResult = True Then
-         TestLog_OK testName
-        Else
-            TestLog_FAIL testName
-        End If
-    Else
-        If TestLog_LastTestResult = True Then
-         TestLog_OK testName, testComment
-        Else
-            TestLog_FAIL testName, testComment
-        End If
-    End If
-End Sub
-
-Sub TestLog_Close()
-    Close #TestLog_FileNo
-    TestLog_FileNo = 0
-End Sub
-
-
-' END *** } Test API
-Rem  *****  MSO MACRO RUNTIME MODULE END  *****
-
-
diff --git a/test/macro/ConvertTests/tweakCallConvention.pl b/test/macro/ConvertTests/tweakCallConvention.pl
deleted file mode 100755
index 6022966ee..000000000
--- a/test/macro/ConvertTests/tweakCallConvention.pl
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/usr/bin/perl  -pi.bak -w
-    s/(TestLog_.*?)\s/Call $1\( /;
-    s/(TestLog_.*)/$1\)/;
diff --git a/test/macro/ConvertTests/tweakModule b/test/macro/ConvertTests/tweakModule
deleted file mode 100755
index c84aaa937..000000000
--- a/test/macro/ConvertTests/tweakModule
+++ /dev/null
@@ -1,6 +0,0 @@
-#!/bin/sh
-theModule=$1
-toolPath=`dirname $0`
-dos2unix $theModule 
-$toolPath/tweakCallConvention.pl $theModule
-unix2dos $theModule
diff --git a/test/macro/ExcelExamples.xls b/test/macro/ExcelExamples.xls
deleted file mode 100644
index 62bc56ac4..000000000
--- a/test/macro/ExcelExamples.xls
+++ /dev/null
diff --git a/test/macro/FontTest.xls b/test/macro/FontTest.xls
deleted file mode 100644
index 127473dd5..000000000
--- a/test/macro/FontTest.xls
+++ /dev/null
diff --git a/test/macro/GoalSeek.xls b/test/macro/GoalSeek.xls
deleted file mode 100644
index 9ebee93dd..000000000
--- a/test/macro/GoalSeek.xls
+++ /dev/null
diff --git a/test/macro/MiscRangeTests.xls b/test/macro/MiscRangeTests.xls
deleted file mode 100644
index b6671a69c..000000000
--- a/test/macro/MiscRangeTests.xls
+++ /dev/null
diff --git a/test/macro/PasteSpecialTest.ods b/test/macro/PasteSpecialTest.ods
deleted file mode 100644
index 6d0ee625d..000000000
--- a/test/macro/PasteSpecialTest.ods
+++ /dev/null
diff --git a/test/macro/SimpleXlCellTypeConstDemo.xls b/test/macro/SimpleXlCellTypeConstDemo.xls
deleted file mode 100644
index ab2bec0c4..000000000
--- a/test/macro/SimpleXlCellTypeConstDemo.xls
+++ /dev/null
diff --git a/test/macro/SimplestWordVBATest.doc b/test/macro/SimplestWordVBATest.doc
deleted file mode 100644
index 9d0a81d1e..000000000
--- a/test/macro/SimplestWordVBATest.doc
+++ /dev/null
diff --git a/test/macro/StdBasicNullVariantRegressionTest.ods b/test/macro/StdBasicNullVariantRegressionTest.ods
deleted file mode 100644
index cb8f5f65f..000000000
--- a/test/macro/StdBasicNullVariantRegressionTest.ods
+++ /dev/null
diff --git a/test/macro/Suse-puzzler.doc b/test/macro/Suse-puzzler.doc
deleted file mode 100644
index 2fbf84c96..000000000
--- a/test/macro/Suse-puzzler.doc
+++ /dev/null
diff --git a/test/macro/Suse-puzzler.xls b/test/macro/Suse-puzzler.xls
deleted file mode 100644
index 83707f541..000000000
--- a/test/macro/Suse-puzzler.xls
+++ /dev/null
diff --git a/test/macro/TestAddress.xls b/test/macro/TestAddress.xls
deleted file mode 100644
index 48d30cbe2..000000000
--- a/test/macro/TestAddress.xls
+++ /dev/null
diff --git a/test/macro/TestColWidthRowHeight.xls b/test/macro/TestColWidthRowHeight.xls
deleted file mode 100644
index 0256a7538..000000000
--- a/test/macro/TestColWidthRowHeight.xls
+++ /dev/null
diff --git a/test/macro/TestFormula.xls b/test/macro/TestFormula.xls
deleted file mode 100644
index bfc434e9e..000000000
--- a/test/macro/TestFormula.xls
+++ /dev/null
diff --git a/test/macro/VariantTest.xls b/test/macro/VariantTest.xls
deleted file mode 100644
index f604cfbe3..000000000
--- a/test/macro/VariantTest.xls
+++ /dev/null
diff --git a/test/macro/aControlDemo.xls b/test/macro/aControlDemo.xls
deleted file mode 100644
index cce2a316b..000000000
--- a/test/macro/aControlDemo.xls
+++ /dev/null
diff --git a/test/macro/aListboxDemo.xls b/test/macro/aListboxDemo.xls
deleted file mode 100644
index 110af8426..000000000
--- a/test/macro/aListboxDemo.xls
+++ /dev/null
diff --git a/test/macro/clock-chart.xls b/test/macro/clock-chart.xls
deleted file mode 100644
index 2a687ac05..000000000
--- a/test/macro/clock-chart.xls
+++ /dev/null
diff --git a/test/macro/errorcheck.xls b/test/macro/errorcheck.xls
deleted file mode 100644
index eae0392a2..000000000
--- a/test/macro/errorcheck.xls
+++ /dev/null
diff --git a/test/macro/goto.xls b/test/macro/goto.xls
deleted file mode 100644
index 7342efbf4..000000000
--- a/test/macro/goto.xls
+++ /dev/null
diff --git a/test/macro/hypocycloid-demo-animated.xls b/test/macro/hypocycloid-demo-animated.xls
deleted file mode 100644
index 07e2bf8e6..000000000
--- a/test/macro/hypocycloid-demo-animated.xls
+++ /dev/null
diff --git a/test/macro/hypocycloid-demo.xls b/test/macro/hypocycloid-demo.xls
deleted file mode 100644
index 2f6b7d7c0..000000000
--- a/test/macro/hypocycloid-demo.xls
+++ /dev/null
diff --git a/test/macro/interaction.ods b/test/macro/interaction.ods
deleted file mode 100644
index 82f6dd419..000000000
--- a/test/macro/interaction.ods
+++ /dev/null
diff --git a/test/macro/interaction.xls b/test/macro/interaction.xls
deleted file mode 100644
index 960f54411..000000000
--- a/test/macro/interaction.xls
+++ /dev/null
diff --git a/test/macro/macrobook-errors.txt b/test/macro/macrobook-errors.txt
deleted file mode 100644
index 3f8e79f91..000000000
--- a/test/macro/macrobook-errors.txt
+++ /dev/null
@@ -1,67 +0,0 @@
-Standard.Invocations.TakesRange ( line 52 )
-1. Object variable not set
-Range argument ( obviously the object that is sent from calc is not a range )
-
-Standard.Invocations.TakesDate ( line 49 )
-2. Inadmissible value or data type mismatch
-Date argument ( obviously the object that is sent from calc is not a Date )
-
-Standard.Invocations.TakesRange ( line 52 )
-3. Object variable not set
-see (1)
-
-Standard.Invocations.TakesRange ( line 52 )
-4. Object variable not set
-see (1)
-
-Standard.ObjectModel.ObjectIsVolatile ( line 7 )
-5. Property or method not found 
-Volatile is not implemented 
-
-Standard.Syntax.StmtWith ( line 52 )
-6. Object variable not set
-couldn't create Selection because api couldn't determine the current document.
-see [1] at end of document
- 
-Standard.FunctionF_I.rtl_filter ( Filter undefined )
-7. Sub-procedure or function procedure not defined
-Filter function or sub-routine not defined
-
-Standard.FunctionF_I.rtl_formatcurrency ( FormatCurrency undefined )
-8. Sub-procedure or function procedure not defined
-ditto for FormatCurrency
-
-Standard.FunctionF_I.rtl_formatnumber( FormatNumber undefined )
-9. Sub-procedure or function procedure not defined
-ditto for FormatNumber
-
-macrostr Standard.FunctionF_I.rtl_formatpercent ( FormatPercent undefined )
-10. Sub-procedure or function procedure not defined
-ditto for FormatPercent
-
-Standard.FunctionJ_R.rtl_replace ( Replace not defined )
-11. Sub-procedure or function procedure not defined
-ditto for Replace
-
-Standard.FunctionS_Y.rtl_strconv ( line 36 )
-12. Action not supported Invalid procedure call.
-StrConv doesn't exist
-
-[1] The api ALWAYS identifies the current document incorrectly because;
-    o the vba api uses basic to find thiscomponent ( which is supposed
-to be the current document ) the fundemental problem is that
-( thiscomponent = "the document loading" )  isn't set up at the time of
-the macro is executed. If there is a ThisComponent then it's incorrect
-as it refers to the previous "current" document.
-        o afaik thiscomponent is normally set when the document is
-loaded and when the document is selected. ( so looks like it maybe
-possible to do this earlier for the former )
-    o in someways the behaviour is consistent for Openoffice.org if you
-load the document and there is no document open ( e.g. just the backing
-window ) you don't actually get a document view replacing the backing
-window until the document is loaded, similarly the
-SfxObjectShell::Current() isn't even setup in this pre-loaded stage.
-( again if another document is open,  SfxObjectShell::Current() will
-refer to that document and not the loading one
-    o excel behavior is the api is most certainly available and the
-current document on load IS the loading document
diff --git a/test/macro/macrobook.xls b/test/macro/macrobook.xls
deleted file mode 100644
index 1fe6d0841..000000000
--- a/test/macro/macrobook.xls
+++ /dev/null
diff --git a/test/macro/missing_vbafeatures.ods b/test/macro/missing_vbafeatures.ods
deleted file mode 100644
index 0c1775646..000000000
--- a/test/macro/missing_vbafeatures.ods
+++ /dev/null
diff --git a/test/macro/quickrangeactivatetest.xls b/test/macro/quickrangeactivatetest.xls
deleted file mode 100644
index 97a2e16bc..000000000
--- a/test/macro/quickrangeactivatetest.xls
+++ /dev/null
diff --git a/test/macro/rangeWalker.xls b/test/macro/rangeWalker.xls
deleted file mode 100644
index 0ada1cfbd..000000000
--- a/test/macro/rangeWalker.xls
+++ /dev/null
diff --git a/test/macro/rkmeyer.xls b/test/macro/rkmeyer.xls
deleted file mode 100644
index ff8fd3ebd..000000000
--- a/test/macro/rkmeyer.xls
+++ /dev/null
diff --git a/test/macro/simpleanimationchart.xls b/test/macro/simpleanimationchart.xls
deleted file mode 100644
index aeacbe0ab..000000000
--- a/test/macro/simpleanimationchart.xls
+++ /dev/null
diff --git a/test/macro/somecontrolsinteraction.xls b/test/macro/somecontrolsinteraction.xls
deleted file mode 100644
index 3e84fd762..000000000
--- a/test/macro/somecontrolsinteraction.xls
+++ /dev/null
diff --git a/test/macro/test-Range-Cells.xls b/test/macro/test-Range-Cells.xls
deleted file mode 100644
index 94f53e931..000000000
--- a/test/macro/test-Range-Cells.xls
+++ /dev/null
diff --git a/test/macro/testdocsynopsis.txt b/test/macro/testdocsynopsis.txt
deleted file mode 100644
index 0766b389b..000000000
--- a/test/macro/testdocsynopsis.txt
+++ /dev/null
@@ -1,36 +0,0 @@
-New test documents should be 
-    * self testing, individual failures should be documented at the end of a test run. If possible expected results should be included in any test report. use TestFormula.xls, TestAddress.xls, MiscRangeTests.xls as examples
-    * Excel documents not Openoffice documents, we want to test import and run of Excel documents.
-        * there may be circumstances where it is necessary to have a '.ods' document to facilitate testing, but, in general this should be avoided if possible.
-
-Document breakdown 
-
-self testing
-============
-TestFormula.xls works
-TestAddress.xls works
-MiscRangeTests.xls works
-TestColWidthRowHeight.xls ( mostly works, some small problems, and one BIG performance one 'test11' fails
-
-demoish
-=======
-interaction.xls  ( mostly ) works ~ 95% ( or more ) also should be added to missing_vbafeatures.xls
-ExcelExamples.xls ( actually is the identical to the above but more more examples, interaction.xls should probably be deleted )
-hypocycloid-demo.xls 	works
-somecontrolsinteraction.xls works
-worm.xls	works
-simpleanimationchart.xls 	works
-clock-chart.xls definitely dosn't work we don't implement chart api
-
-misc
-====
-ConstCheck.xls works but should be more self testing
-vbatest.xls	seems to work ( not sure )
-SimpleXlCellTypeConstDemo.xls (half works)
-macrobook.xls ( some things work, others don't, the don't work bits need to be documented in missing_vbafeatures.xls )
-
-ods variants
-============
-in general ignore these ( probably should be removed but should be examined for test content that can be extracted into new self testing xls documents )
-
-
diff --git a/test/macro/vba_donated_docs/Agence_2006-2-OLD.XLS b/test/macro/vba_donated_docs/Agence_2006-2-OLD.XLS
deleted file mode 100644
index 0924216f9..000000000
--- a/test/macro/vba_donated_docs/Agence_2006-2-OLD.XLS
+++ /dev/null
diff --git a/test/macro/vba_donated_docs/Auto_2006_AK.XLS b/test/macro/vba_donated_docs/Auto_2006_AK.XLS
deleted file mode 100644
index 9fa9a9f14..000000000
--- a/test/macro/vba_donated_docs/Auto_2006_AK.XLS
+++ /dev/null
diff --git a/test/macro/vba_donated_docs/rkmeyer.xls b/test/macro/vba_donated_docs/rkmeyer.xls
deleted file mode 100644
index ff8fd3ebd..000000000
--- a/test/macro/vba_donated_docs/rkmeyer.xls
+++ /dev/null
diff --git a/test/macro/vba_donated_docs/substitution.xls b/test/macro/vba_donated_docs/substitution.xls
deleted file mode 100644
index 4a1773dbd..000000000
--- a/test/macro/vba_donated_docs/substitution.xls
+++ /dev/null
diff --git a/test/macro/vba_streams/excel-vba-streams-#1.bas b/test/macro/vba_streams/excel-vba-streams-#1.bas
deleted file mode 100644
index 33f1db36c..000000000
--- a/test/macro/vba_streams/excel-vba-streams-#1.bas
+++ /dev/null
@@ -1,333707 +0,0 @@
-Project Name : 'ProjectFoo'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Simple
->>>>>>
-Attribute VB_Name = "Simple"
-Function SGetThree()
-SGetThree = 3
-End Function
-
-Function SLoop()
-Dim i As Integer
-Dim j As Integer
-j = 0
-For i = 0 To 10
-    j = j + 1
-Next i
-SLoop = j
-End Function
-
-Function SNoRetVal()
-End Function
-<<<<<<
-======================
-MoreComplex
->>>>>>
-Attribute VB_Name = "MoreComplex"
-Function MGetThree()
-MGetThree = 3
-If MGetThree = 2 Then
- MsgBox ("Hello World")
-End If
-End Function
-
-Function MLoop()
-Dim i As Integer
-Dim j As Integer
-j = 0
-For i = 0 To 10
-    j = j + 1
-Next i
-If j = 17 Then
-    MLoop = Application.Sum(Range("A1:A10"))
-End If
-MLoop = j
-End Function
-
-Function MNoRetVal()
-Dim i As Integer
-End Function
-<<<<<<
-======================
-Real
->>>>>>
-Attribute VB_Name = "Real"
-Function CtoF(Centigrade)
-  CtoF = Centigrade * 9 / 5 + 32
-End Function
-
-Function WsF(Angle)
-  WsF = WorksheetFunction.Sinh(Angle)
-End Function
-<<<<<<
-======================
-FuncVal
->>>>>>
-Attribute VB_Name = "FuncVal"
-Function MyString()
-MyString = "teststring"
-End Function
-
-Function MyDouble()
-MyDouble = 1 / 8
-End Function
-
-Function MyBoolean()
-MyBoolean = False
-End Function
-
-Function MyInt()
-MyInt = 7
-End Function
-
-Function TakeOneArg(arg1)
-TakeOneArg = arg1
-End Function
-
-Function TakeTwoArgs(arg1, arg2)
-TakeTwoArgs = arg2
-End Function
-
-Function TakeThreeArgs(arg1, arg2, arg3)
-TakeThreeArgs = arg3
-End Function
-
-Function ContainsComment()
-Rem This is a comment
-ContainsComment = 3
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-   
-    On Error Resume Next
-    Worksheets("Example4").ChartObjects.Delete
- 
-End Sub
-
-Private Sub Workbook_Open()
-    Worksheets("Change History").Activate
-    Range("VersionStart").Select
-    Selection.End(xlDown).Select
-    Selection.Copy (Worksheets("Overview").Range("VersionNumber"))
-    
-    On Error Resume Next
-    Worksheets("Example4").ChartObjects.Delete
-    
-    Worksheets("Overview").Activate
-    Range("A1").Activate
-
-End Sub
-<<<<<<
-======================
-UserForm1
->>>>>>
-Attribute VB_Name = "UserForm1"
-Attribute VB_Base = "0{DFA44B18-A9D7-11DA-9F20-0000E8226B19}{DFA44B00-A9D7-11DA-9F20-0000E8226B19}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-Dim ComboChoices()
-Private Sub CheckBox1_Click()
-
-End Sub
-
-Private Sub ComboBox1_Change()
-
-End Sub
-
-Private Sub CommandButton1_Click()
-    With UserForm1
-        .ValueOfTextBox.Value = .TextBox1.Value
-        .StateOfCheckBox.Value = .CheckBox1.Value
-        .StateOfOption1.Value = .OptionButton1.Value
-        .StateOfOption2.Value = .OptionButton2.Value
-        
-        If .ComboBox1.ListIndex > -1 Then
-            .SelectedItemComboBox.Value = ComboChoices(.ComboBox1.ListIndex)
-        Else
-            .SelectedItemComboBox.Value = "Unkown"
-        End If
-    End With
-End Sub
-
-Private Sub Label2_Click()
-
-End Sub
-
-Private Sub OptionButton1_Click()
-
-End Sub
-
-Private Sub Label3_Click()
-
-End Sub
-
-Private Sub UserForm_Click()
-
-End Sub
-
-Private Sub UserForm_Initialize()
-    ComboChoices = Array("Choice1", "Choice2", "Choice3")
-    With UserForm1.ComboBox1
-        .AddItem ComboChoices(0)
-        .AddItem ComboChoices(1)
-        .AddItem ComboChoices(2)
-    End With
-    
-    With UserForm1
-        .ValueOfTextBox.Value = ""
-        .StateOfCheckBox.Value = ""
-        .StateOfOption1.Value = ""
-        .StateOfOption2.Value = ""
-        .SelectedItemComboBox.Value = ""
-    End With
-    
-End Sub
-
-Private Sub ValueOfTextBox_Change()
-
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("WbkInformationArea").ClearContents
-    Application.Wait (Now() + TimeValue("00:00:01"))
-    Range("WbkPath").Value = ActiveWorkbook.Path
-    Range("WbkActiveWorkbook") = ActiveWorkbook.Name
-    Range("WbkActiveWorksheet") = ActiveSheet.Name
-    Range("WbkActiveCell") = ActiveCell.Address
-    Range("CurrentDateTime") = Now()
-    Range("WkShNameArea").ClearContents
-    Call ListAllWorksheets
-End Sub
-
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("WbkActiveCell") = Target.Address
-    Range("CurrentDateTime") = Now()
-End Sub
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton3Ex5, 3, 2, MSForms, CommandButton"
-
-Private Sub CommandButton3Ex5_Click()
-    Call ElementOperations
-End Sub
-
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Not (Intersect(Target, Range("MyCell")) Is Nothing) Then
-        Select Case LCase(Target.Value)
-            Case "a", "e", "i", "o", "u"
-                Range("MsgCell").Value = "vowel"
-                
-            Case "b" To "d", "f" To "h", "j" To "n", "p" To "t", "v" To "z"
-                Range("MsgCell").Value = "consonant"
-            
-            Case 0 To 9
-                Range("MsgCell").Value = "number"
-                
-            Case Else
-                Range("MsgCell").Value = "unknown"
-        End Select
-        Target.Select
-    End If
-    
-    If Not (Intersect(Target, Range("MyVector")) Is Nothing) Then
-        Range("ElementProduct").ClearContents
-        Range("ElementSum").ClearContents
-    End If
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1Ex4, 2, 0, MSForms, CommandButton"
-Private Sub CommandButton1Ex4_Click()
-    Call GenerateChart
-End Sub
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButtonEx6, 1, 0, MSForms, CommandButton"
-Private Sub CommandButtonEx6_Click()
-        MsgBox "Button Click recognized"
-End Sub
-
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton2Ex2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3Ex2, 3, 2, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton4Ex2, 5, 4, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton5Ex2, 6, 5, MSForms, CommandButton"
-Private Sub CommandButton1Ex2_Click()
-    Call getApplProperties
-End Sub
-
-Private Sub CommandButton2Ex2_Click()
-    Call generateDataToSort
-End Sub
-
-Private Sub CommandButton3Ex2_Click()
-    Call SortWithScreenUpdating
-End Sub
-
-Private Sub CommandButton4Ex2_Click()
-    Call SortWithNoScreenUpdating
-End Sub
-
-Private Sub CommandButton5Ex2_Click()
-    Call generateDataToSort
-End Sub
-
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-SampleCode
->>>>>>
-Attribute VB_Name = "SampleCode"
-'''
-''' Contains various VBA coding examples on accessing the Application Object
-'''
-Option Explicit
-
-Sub generateDataToSort()
-    Dim i As Integer
-    
-    With Range("SortArray")
-        For i = 1 To .Rows.Count
-            .Cells(i) = Int((100 * Rnd) + 1)    ' Generate random value between 1 and 100.
-        Next i
-    End With
-
-End Sub
-
-Sub SortWithScreenUpdating()
-    Application.ScreenUpdating = True
-    Call BubbleSort(Range("SortArray"))
-    Range("SortArray").Select
-    MsgBox "Sorting Completed"
-End Sub
-Sub SortWithNoScreenUpdating()
-    Application.ScreenUpdating = False
-    Call BubbleSort(Range("SortArray"))
-    Range("SortArray").Select
-    Application.ScreenUpdating = True
-    MsgBox "Sorting Completed"
-End Sub
-
-Sub BubbleSort(rngToSort As Range)
-    Dim i, j As Integer
-    Dim Temp As Variant
-
-    With rngToSort
-        For j = .Rows.Count To 1 Step -1
-            For i = 1 To j
-                .Cells(i).Interior.ColorIndex = 6
-                .Cells(j).Interior.ColorIndex = 8
-                Application.Wait (Now + TimeValue("0:00:01"))
-                If .Cells(i) > .Cells(j) Then
-                    Temp = .Cells(i)
-                    .Cells(i) = .Cells(j)
-                    .Cells(j) = Temp
-                End If
-                .Cells(i).Interior.ColorIndex = xlColorIndexNone
-                .Cells(j).Interior.ColorIndex = xlColorIndexNone
-            Next i
-        Next j
-    
-    End With
-
-End Sub
-
-Sub ElementOperations()
-    Range("ElementProduct").Value = WorksheetFunction.Sum(Range("MyVector"))
-    Range("ElementSum").Value = WorksheetFunction.Product(Range("MyVector"))
-End Sub
-
-Sub ListAllWorksheets()
-    Dim wksh As Worksheet
-    Dim i As Integer
-    
-    With Range("WkShNames")
-        i = 1
-        For Each wksh In ActiveWorkbook.Worksheets
-            .Cells(i).Value = wksh.Name
-            i = i + 1
-        Next
-    End With
-
-End Sub
-
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1Ex7, 1, 0, MSForms, CommandButton"
-Private Sub CommandButton1Ex7_Click()
-    UserForm1.Show
-End Sub
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ChartDemoCode
->>>>>>
-Attribute VB_Name = "ChartDemoCode"
-Sub GenerateChart()
-Attribute GenerateChart.VB_Description = "Macro recorded 5/14/2004 by Jim Thompson"
-Attribute GenerateChart.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro2 Macro
-' Macro recorded 5/14/2004 by Jim Thompson
-'
-
-'
-    Range("ChartData").Select
-    Charts.Add
-    ActiveChart.ChartType = xlColumnClustered
-    ActiveChart.Name = "Sample Chart"
-    ActiveChart.SetSourceData Source:=Sheets("Example4").Range("ChartData"), PlotBy:= _
-        xlColumns
-    ActiveChart.Location Where:=xlLocationAsObject, Name:="Example4"
-    With ActiveChart
-        .HasTitle = True
-        .HasLegend = False
-        .ChartTitle.Characters.Text = "Sample Chart"
-        .Axes(xlCategory, xlPrimary).HasTitle = True
-        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Category"
-        .Axes(xlValue, xlPrimary).HasTitle = True
-        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Amount"
-    End With
-    
-    Range("ChartData").Select
-End Sub
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1Ex3, 1, 0, MSForms, CommandButton"
-Private Sub CommandButton1Ex3_Click()
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Range("UpperLeftCell").Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Selection.End(xlToRight).Select
-    Range("RangeAddress") = Selection. _
-          Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Selection.End(xlDown).Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Selection.End(xlToLeft).Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Selection.End(xlUp).Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Range(Selection, Selection.End(xlToRight)).Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Range("UpperLeftCell").Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Range(Selection, Selection.End(xlDown)).Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Range("UpperLeftCell").Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Selection.CurrentRegion.Select
-    Range("RangeAddress") = Selection.Address
-End Sub
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-test_main
-End Sub
-
-Private Sub CommandButton2_Click()
-init
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Base 1
-Dim numTests As Integer
-
-Sub init()
-numTests = 23
-reset_results
-End Sub
-Sub test_main()
-init
-On Error Resume Next ' comment out this line to help debug errors
-test1
-test2
-test3
-test4
-test5
-test6
-test7
-test8
-test9
-test10
-test11
-test12
-test13
-test14
-test15
-test16
-test17
-test18
-test19
-test20
-test21
-test22
-test23
-display_results
-End Sub
-
-
-' result for test 1 is in named range test1
-' Tests .Value property LHS assignment
-Sub test1()
-Range("B1").Value = 50
-If Range("B1").Value = 50 Then
-    Range("test1").Value = 1
-End If
-End Sub
-' result for test 2 is in named range test2
-' Tests ( default ) .Value property LHS assignment
-Sub test2()
-Range("B2") = 50
-If Range("B2").Value = 50 Then
-    Range("test2").Value = 1
-End If
-End Sub
-' result for test 3 is in named range test3
-' Tests RHS .Value property assignment
-
-Sub test3()
-Dim testVal As Integer
-testVal = 99
-Range("B3").Value = 50
-testVal = Range("B3").Value
-If testVal = 50 Then
-    Range("test3").Value = 1
-End If
-End Sub
-
-' result for test 4 is in named range test4
-' Tests RHS .Value default property assignment
-
-Sub test4()
-Dim testVal As Integer
-testVal = 99
-Range("B4").Value = 50
-testVal = Range("B4")
-If testVal = 50 Then
-    Range("test4").Value = 1
-End If
-End Sub
-' result for test 5 is in named range test5
-' Tests Range("XX") = Range("YY").Value ( lhs) default value property assignment
-' LHS is a cleared cell
-Sub test5()
-Range("B5").Value = 50
-Range("B6") = Range("B5").Value
-If Range("B6").Value = 50 Then
-    Range("test5").Value = 1
-End If
-
-End Sub
-
-' result for test 6 is in named range test6
-' Tests Range("XX").Value = Range("YY") ( rhs) default value property access
-' LHS is a cleared cell
-Sub test6()
-Range("B7").Value = 50
-Range("B8").Value = Range("B7")
-If Range("B8").Value = 50 Then
-    Range("test6").Value = 1
-End If
-End Sub
-' result for test 7 is in named range test7
-' Tests Range("XX") = Range("YY")
-' (rhs) default value property access
-' (lhs) default value property set
-' LHS is a cleared cell
-Sub test7()
-Range("B9").Value = 50
-Range("B10") = Range("B9")
-If Range("B10").Value = 50 Then
-    Range("test7").Value = 1
-End If
-End Sub
-
-' result for test 8 is in named range test8
-' Tests set objectVariable to a Range("YY") object
-Sub test8()
-Dim aRange As Object
-Range("B11") = 99
-Set aRange = Range("B11")
-If aRange.Value = 99 Then
-    Range("test8").Value = 1
-End If
-End Sub
-' result for test 9 is in named range test9
-' Tests Multiplication of a range, in Openoffice
-' val = Range("B12") * 0.1
-' this was failing due to Range("B12") getting overwritten
-' with the result of the calculation e.g. Range("B12") had 9 if
-' initial value of B12 was 90
-Sub test9()
-Range("B12").Value = 90
-Dim val As Integer
-val = 0
-val = (Range("B12") * 0.1)
-Range("B13") = val
-If Range("B13").Value = 9 And Range("B12").Value = 90 Then
-    Range("test9").Value = 1
-End If
-End Sub
-' result for test 10 is in named range test10
-' Tests multiplication of Range, there was a bug
-' in OO where "B15" in the test below would be overwritten
-' with 10
-Sub test10()
-Range("B15") = 100
-Range("B14") = (Range("B15") * 0.1)
-If Range("B14").Value = 10 And Range("B15") = 100 Then
-    Range("test10").Value = 1
-End If
-
-End Sub
-
-
-' result for test 11 is in named range test11
-' test the result of a 2-Dim range value prop
-' which should be a 2 Dim array containing the values
-' as set up in the tests below
-' e.g.
-' 1 4 7 10
-' 2 5 8 11
-' 3 6 9 12
-
-Sub test11()
-Dim testDatasc1
-Dim testDatasc2
-Dim testDatasc3
-Dim testDatasc4
-Dim cellNamesc1
-Dim cellNamesc2
-Dim cellNamesc3
-
-Dim cellName As String
-Dim cellval As Integer
-Dim colValues()
-
-testDatac1 = Array(1, 2, 3)
-testDatac2 = Array(4, 5, 6)
-testDatac3 = Array(7, 8, 9)
-testDatac4 = Array(10, 11, 12)
-
-colValues = Array(testDatac1, testDatac2, testDatac3, testDatac4)
-
-cellNamesc1 = Array("D1", "D2", "D3")
-cellNamesc2 = Array("E1", "E2", "E3")
-cellNamesc3 = Array("F1", "F2", "F3")
-cellNamesc4 = Array("G1", "G2", "G3")
-
-' set cellnames with values
-arrayset cellNamesc1, testDatac1
-arrayset cellNamesc2, testDatac2
-arrayset cellNamesc3, testDatac3
-arrayset cellNamesc4, testDatac4
-
-Dim contents As Variant
-Dim colcontents As Variant
-
-' get contents of range
-
-contents = Range("D1:G3").Value
-Dim lcol As Integer
-Dim ucol As Integer
-Dim col As Integer
-lcol = LBound(contents, 2)
-ucol = UBound(contents, 2)
-Dim res As Integer
-result = 1 ' success
-
-' check values
-For col = lcol To ucol
-
-    colcontents = getCol(contents, col)
-    For counter = LBound(colcontents) To UBound(colcontents)
-        'MsgBox " content of col " & col & " index " & counter & " has value " & colcontents(counter)
-        If checkarray(colcontents, colValues(col)) = False Then
-            result = -1
-            Exit For
-        End If
-        
-    Next counter
-Range("test11").Value = result
-Next col
-
-
-' note
-' Range("D4:G6") = Range("D1:G3") does not do a copy
-' nor does Range("D4:G6") = Range("D1:G3".Value
-' or Range("D4:G6").Value = Range("D1:G3")
-End Sub
-
-' tests a copy of a multicell range to
-' a multi cell range of the same dimensions
-
-Sub test12()
-
-Dim testDatasc1
-Dim testDatasc2
-Dim testDatasc3
-Dim testDatasc4
-Dim cellNamesc1
-Dim cellNamesc2
-Dim cellNamesc3
-
-Dim cellName As String
-Dim cellval As Integer
-Dim colValues()
-
-testDatac1 = Array(1, 2, 3)
-testDatac2 = Array(4, 5, 6)
-testDatac3 = Array(7, 8, 9)
-testDatac4 = Array(10, 11, 12)
-
-colValues = Array(testDatac1, testDatac2, testDatac3, testDatac4)
-
-cellNamesc1 = Array("D6", "D7", "D8")
-cellNamesc2 = Array("E6", "E7", "E8")
-cellNamesc3 = Array("F6", "F7", "F8")
-cellNamesc4 = Array("G6", "G7", "G8")
-' set cellnames with values
-arrayset cellNamesc1, testDatac1
-arrayset cellNamesc2, testDatac2
-arrayset cellNamesc3, testDatac3
-arrayset cellNamesc4, testDatac4
-
-Range("D9:G11").Value = Range("D6:G8").Value
-
-' Check the result of Range("D9:G11")
-Dim result As Integer
-result = 1 ' assume pass
-
-Dim origcontents
-Dim copycontents
-
-origcontents = Range("D6:G8").Value
-copycontents = Range("D9:G11").Value
-Dim lb1 As Integer
-Dim ub1 As Integer
-Dim lb2 As Integer
-Dim ub2 As Integer
-lb1 = LBound(origcontents, 1)
-ub1 = UBound(origcontents, 1)
-lb2 = LBound(origcontents, 2)
-ub2 = UBound(origcontents, 2)
-Dim i As Integer
-Dim j As Integer
-For i = lb1 To ub1
-    For j = lb2 To ub2
-        If copycontents(i, j) <> origcontents(i, j) Then
-            result = -1
-            Exit For
-        End If
-    Next j
-    If result = -1 Then
-        Exit For
-    End If
-    
-Next i
-Range("test12").Value = result
-End Sub
-
-' test setting Range.Value with 2 Dim array
-
-Sub test13()
-Dim dArray
-dArray = Range("D12:g14")
-Dim lb1 As Integer
-Dim ub1 As Integer
-Dim lb2 As Integer
-Dim ub2 As Integer
-lb1 = LBound(dArray, 1)
-ub1 = UBound(dArray, 1)
-lb2 = LBound(dArray, 2)
-ub2 = UBound(dArray, 2)
-Dim count As Integer
-For i = lb1 To ub1
-    For j = lb2 To ub2
-        dArray(i, j) = count
-        count = count + 1
-    Next j
-Next i
-Range("D12:g14").Value = dArray
-
-' get values for Range
-Dim contents
-Dim result As Integer
-result = 1
-contents = Range("D12:g14").Value
-
-' compare to values from array
-For i = lb1 To ub1
-    For j = lb2 To ub2
-        If contents(i, j) <> dArray(i, j) Then
-            result = -1
-            Exit For
-        End If
-        count = count + 1
-    Next j
-    If result = -1 Then
-        Exit For
-    End If
-Next i
-
-Range("test13").Value = result
-End Sub
-' test Range("XX").Value = number
-' the number should be applied over the range
-Sub test14()
-
-Dim contents
-Dim dValue As Integer
-dValue = 99
-Range("D16:F17").Value = dValue
-
-contents = Range("D16:F17").Value
-Dim lb1 As Integer
-Dim ub1 As Integer
-Dim lb2 As Integer
-Dim ub2 As Integer
-Dim result As Integer
-result = 1 '
-lb1 = LBound(contents, 1)
-ub1 = UBound(contents, 1)
-lb2 = LBound(contents, 2)
-ub2 = UBound(contents, 2)
-For i = lb1 To ub1
-    For j = lb2 To ub2
-        If contents(i, j) <> dValue Then
-            result = -1
-            Exit For
-        End If
-    If result = -1 Then
-        Exit For
-    End If
-    
-        
-    Next j
-Next i
-Range("test14").Value = result
-End Sub
-' test assigment of row Range to a single Array
-Sub test15()
-Dim testData()
-testData = Array(1, 2, 3, 4, 5)
-Range("A20:E20").Value = testData()
-Dim resultData()
-resultData = Range("A20:E20").Value
-Dim result As Integer
-result = 1 '
-RowIndex = LBound(resultData, 1)
-For count = LBound(resultData, 2) To UBound(resultData, 2)
-    If resultData(RowIndex, count) <> testData(count) Then
-        result = -1
-        Exit For
-    End If
-        
-    
-Next count
-Range("test15") = result
-End Sub
-
-' test assigment of col Range to a single Array
-
-Sub test16()
-Dim testData()
-testData = Array(1, 2, 3, 4, 5)
-Range("A21:A25").Value = testData()
-Dim resultData()
-resultData = Range("A21:A25").Value
-Dim result As Integer
-result = 1 '
-ColIndex = LBound(resultData, 2)
-For count = LBound(resultData, 1) To UBound(resultData, 1)
-    If resultData(count, ColIndex) <> testData(LBound(testData)) Then
-        result = -1
-        Exit For
-    End If
-        
-    
-Next count
-Range("test16") = result
-End Sub
-
-' test assigment of range to a single Array
-' to a Range of the same row size
-Sub test17()
-Dim testData()
-testData = Array(1, 2, 3, 4, 5)
-Range("A28:E29").Value = testData()
-
-Dim resultData()
-resultData = Range("A28:E29").Value
-Dim result As Integer
-result = 1 '
-
-For row = LBound(resultData, 1) To UBound(resultData, 1)
-    For col = LBound(resultData, 2) To UBound(resultData, 2)
-    'MsgBox row & "," & col & " = " & resultData(row, col)
-        If resultData(row, col) <> testData(col) Then
-            result = -1
-            Exit For
-        End If
-    Next col
-Next row
-Range("test17") = result
-End Sub
-' Test18 tests ActiveSheet.Range( Cell1, Cell2 ) method
-' results involve no offset, unlike Range.Range( Cell1, Cell2 )
-' simple range
-Sub test18()
-Dim result As Integer
-Range("c5").Select
-result = 1
-If ActiveSheet.Range(Range("a2"), Range("d5")).Address <> "$A$2:$D$5" Then
-    result = -1
-End If
-Range("test18") = result
-
-End Sub
-' Test19 tests ActiveSheet.Range( Cell1, Cell2 ) method
-' results involve no offset, unlike Range.Range( Cell1, Cell2 )
-' more complex range, the range selected is the greatest range defined
-' by overlap of Cell1 & Cell2
-Sub test19()
-Dim result As Integer
-Range("c5").Select
-result = 1
-If ActiveSheet.Range(Range("a2:d6"), Range("d5:d8")).Address <> "$A$2:$D$8" Then
-    result = -1
-End If
-Range("test19") = result
-
-End Sub
-
-Sub test20()
-Dim result As Integer
-result = 1
-If Range("c5").Range("a2").Address <> "$C$6" Then
-    result = -1
-End If
-Range("test20") = result
-End Sub
-
-
-Sub test21()
-Dim result As Integer
-result = 1
-If Range("c5:f10").Range("g4").Address <> "$I$8" Then
-    result = -1
-End If
-Range("test21") = result
-End Sub
-
-Sub test22()
-Dim result As Integer
-result = 1
-If Range("c5:c8").Range(Range("g4"), Range("l10")).Address <> "$I$8:$N$14" Then
-    result = -1
-End If
-Range("test22") = result
-End Sub
-Sub test23()
-Dim result As Integer
-result = 1
-If Range("c5:f10").Range("g4:i8").Address <> "$I$8:$K$12" Then
-    result = -1
-End If
-Range("test23") = result
-End Sub
-
-Function getCol(matrix As Variant, col As Integer) As Variant
-Dim lrow As Integer
-Dim urow As Integer
-Dim row As Integer
-lrow = LBound(matrix, 1)
-urow = UBound(matrix, 1)
-
-Dim column()
-ReDim column(urow)
-
-For row = lrow To urow
-    'column(row) = matrix(col, row)
-    Dim val As Integer
-    column(row) = matrix(row, col)
-Next row
-getCol = column()
-End Function
-Function checkarray(values As Variant, newvalues As Variant) As Boolean
-Dim count As Integer
-Dim result As Boolean
-result = True
-For count = LBound(values) To UBound(values)
-    If values(count) <> newvalues(count) Then
-        result = False
-        Exit For
-    End If
-Next count
-checkarray = result
-End Function
-Sub arrayset(names As Variant, values As Variant)
-Dim count As Integer
-Dim cellName As String
-Dim cellval As Integer
-
-For count = LBound(names) To UBound(values)
-    cellName = names(count)
-    cellval = values(count)
-    Range(cellName).Value = cellval
-Next count
-End Sub
-
-Sub reset_results()
-For count = 1 To numTests
-    Range("test" & count).Value = -1
-Next count
-' test 1
-Range("B1").Clear
-' test 2
-Range("B2").Clear
-' test 3
-Range("B3").Clear
-' test 4
-Range("B4").Clear
-' test 5
-Range("B5").Clear
-Range("B6").Clear
-' test 6
-Range("B7").Clear
-Range("B8").Clear
-' test 7
-Range("B9").Clear
-Range("B10").Clear
-' test 8
-Range("B11").Clear
-' test 9
-Range("B12").Clear
-Range("B13").Clear
-' test 10
-Range("B14").Clear
-Range("B15").Clear
-' test 11
-Range("D1:G3").Clear
-' test 12
-Range("D6:G8").Clear
-Range("D9:g11").Clear
-' test 13
-Range("D12:g14").Clear
-' test 14
-Range("D16:F17").Clear
-' test 15
-Range("A20:E20").Clear
-' test 16
-Range("A20:A25").Clear
-' test 17
-Range("A28:E29").Clear
-End Sub
-
-Sub display_results()
-Dim results As String
-Dim failed As String
-
-Dim count As Integer
-Dim testsRun As Integer
-
-For count = 1 To numTests
-    If testResult("test" & count) = False Then
-        failed = failed & "      test" & count & " failed" & Chr$(10)
-    Else
-        succeeded = succeeded + 1
-    End If
-Next count
-testsRun = count - 1
-results = results & "No. tests: " & numTests & Chr$(10)
-
-results = results & "Summary" & Chr$(10)
-results = results & "=======" & Chr$(10)
-results = results & "Run:       " & testsRun & Chr$(10)
-results = results & "Passed:    " & succeeded & Chr$(10)
-results = results & "Failed:    " & (testsRun - succeeded) & Chr$(10)
-results = results & failed
-results = results & Chr$(10) + "Expected Failure On OpenOffice: test13"
-MsgBox results
-End Sub
-
-Function testResult(arg As String) As Boolean
-If (Range(arg).Value = 1) Then
-    testResult = True
-Else
-    testResult = False
-End If
-End Function
-
-
-Sub tempStuff()
-
-' in openoffice a1 = 5, in xl its 50
-' the line below seems not do the expected in xl (?)
-Range("B1") = 50
-Range("A1").Value = (Range("B1").Value * 0.1)
-MsgBox ("A1 = " + Range("A1"))
-Range("A1") = Range("B1").Value
-Range("B2") = 100
-Range("B3") = Range("B2")
-MsgBox "B3 = " & Range("B3")
-
-val = Range("A1")
-MsgBox (Range("A1"))
-    
-'Range("A5:A8").Value =Range("A1:A4").Value
-MsgBox (val)
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub main()
-test (xlCellTypeAllFormatConditions)
-test2 (Excel.XlCellType.xlCellTypeAllValidation)
-test3 (XlCellType.xlCellTypeAllValidation)
-test4 xlCellTypeSameValidation
-End Sub
-
-Function test(ByRef num As Integer)
-MsgBox "test got " & num
-End Function
-
-Function test2(num)
-MsgBox "test2 got " & num
-End Function
-
-
-Function test3(num)
-MsgBox "test3 got " & num
-End Function
-
-Function test4(num)
-MsgBox "test4 got " & num
-End Function
-<<<<<<
-Project Name : 'VBProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-Dim NextTick
-
-Sub StartClock()
-    UpdateClock
-End Sub
-
-Sub StopClock()
-'   Cancels the OnTime event (stops the clock)
-    On Error Resume Next
-    Application.OnTime NextTick, "UpdateClock", , False
-End Sub
-
-Sub cbClockType_Click()
-'   Hides or unhids the clock
-    With ThisWorkbook.Sheets("Clock")
-        If .DrawingObjects("cbClockType").Value = xlOn Then
-            .ChartObjects("ClockChart").Visible = True
-        Else
-            .ChartObjects("ClockChart").Visible = False
-        End If
-    End With
-End Sub
-
-Sub UpdateClock()
-'   Updates the clock that's visible
-    Dim Clock As Chart
-    Set Clock = ThisWorkbook.Sheets("Clock").ChartObjects("ClockChart").Chart
-    
-    If Clock.Parent.Visible Then
-'       ANALOG CLOCK
-        Const PI As Double = 3.14159265358979
-        Dim CurrentSeries As Series
-        Dim s As Series
-        Dim x(1 To 2) As Variant
-        Dim v(1 To 2) As Variant
-    
-'       Hour hand
-        Set CurrentSeries = Clock.SeriesCollection("HourHand")
-        x(1) = 0
-        x(2) = 0.5 * Sin((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12))
-        v(1) = 0
-        v(2) = 0.5 * Cos((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12))
-        CurrentSeries.XValues = x
-        CurrentSeries.Values = v
-        
-'       Minute hand
-        Set CurrentSeries = Clock.SeriesCollection("MinuteHand")
-        x(1) = 0
-        x(2) = 0.8 * Sin((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60))
-        v(1) = 0
-        v(2) = 0.8 * Cos((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60))
-        CurrentSeries.XValues = x
-        CurrentSeries.Values = v
-    
-'       Second hand
-        Set CurrentSeries = Clock.SeriesCollection("SecondHand")
-        x(1) = 0
-        x(2) = 0.85 * Sin(Second(Time) * (2 * PI / 60))
-        v(1) = 0
-        v(2) = 0.85 * Cos(Second(Time) * (2 * PI / 60))
-        CurrentSeries.XValues = x
-        CurrentSeries.Values = v
-    Else
-'       DIGITAL CLOCK
-        ThisWorkbook.Sheets("Clock").Range("DigitalClock").Value = CDbl(Time)
-    End If
-    
-'   Set up the next event one second from now
-    NextTick = Now + TimeValue("00:00:01")
-    Application.OnTime NextTick, "UpdateClock"
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-    Call StartClock
-End Sub
-
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    Call StopClock
-End Sub
-
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-' Developed by John Walkenbach
-' of JWalk and Associates
-' http://www.j-walk.com/ss/
-' Thanks to GeeDee for suggesting the animation and colors.
-
-Dim r As Long
-
-
-
-
-Sub Scroller_Click()
-    Range("FavoriteNum").Value = " "
-End Sub
-Sub RandomButton_Click()
-    Application.ScreenUpdating = False
-    Range("a_inc").Value = Rnd() * 1000
-    Range("b_inc").Value = Rnd() * 1000
-    Range("t_inc").Value = Rnd() * 1000
-    Range("FavoriteNum").Value = ""
-    Application.ScreenUpdating = True
-End Sub
-
-Sub NextFavoriteButton_Click()
-    Application.ScreenUpdating = False
-    r = Range("FavoriteNum").Value + 1
-    If r > Application.CountA(Range("Favorites").EntireColumn) Then r = 1
-    Range("a_inc").Value = Range("Favorites").Offset(r - 1, 0).Value
-    Range("b_inc").Value = Range("Favorites").Offset(r - 1, 1).Value
-    Range("t_inc").Value = Range("Favorites").Offset(r - 1, 2).Value
-    Range("FavoriteNum").Value = r
-    Application.ScreenUpdating = True
-End Sub
-
-Sub PreviousFavoriteButton_Click()
-    Application.ScreenUpdating = False
-    r = Range("FavoriteNum").Value - 1
-    If r <= 0 Then r = Application.CountA(Range("Favorites").EntireColumn)
-    Range("a_inc").Value = Range("Favorites").Offset(r - 1, 0).Value
-    Range("b_inc").Value = Range("Favorites").Offset(r - 1, 1).Value
-    Range("t_inc").Value = Range("Favorites").Offset(r - 1, 2).Value
-    Range("FavoriteNum").Value = r
-    Application.ScreenUpdating = True
-End Sub
-
-Sub AddToFavoritesButton_Cklick()
-Attribute AddToFavoritesButton_Cklick.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim EmptyStr As String
-    EmptyStr = ""
-    
-    If Range("FavoriteNum").Value = EmptyStr Then
-        Application.ScreenUpdating = False
-        Application.Calculation = xlCalculationManual
-        r = Application.CountA(Range("Favorites").EntireColumn) + 1
-        Range("FavoriteNum").Value = r
-        Cells(r, Range("Favorites").Column) = Range("a_inc").Value
-        Cells(r, Range("Favorites").Column + 1) = Range("b_inc").Value
-        Cells(r, Range("Favorites").Column + 2) = Range("t_inc").Value
-        Application.Calculation = xlCalculationAutomatic
-        Application.ScreenUpdating = True
-    End If
-End Sub
-
-
-
-
-
-Sub InfoButton_Click()
-    ChartIsAnimated = False
-    Sheets("Info").Activate
-    Range("A2").Select
-End Sub
-
-Sub ReturnButton_Click()
-    Sheets("Chart").Activate
-    Range("E4").Select
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-    ThisWorkbook.Windows(1).WindowState = xlNormal
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If Range("CloseFlag") <> "Y" Then
-        Worksheets("Workbook Examples").Activate
-        Range("CloseFlag").Activate
-        MsgBox "CloseFlag Cell must be 'Y' to close workbook"
-        Cancel = True
-    End If
-End Sub
-
-Private Sub Workbook_Open()
-    Worksheets("Change History").Activate
-    Range("VersionStart").Select
-    Selection.End(xlDown).Select
-    Selection.Copy (Worksheets("Overview").Range("VersionNumber"))
-    Worksheets("Workbook Examples").Activate
-    Range("CloseFlag") = "N"
-    Worksheets("Overview").Activate
-    Range("A1").Activate
-
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3, 4, 2, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    Call ListAllWorksheets
-End Sub
-
-Private Sub CommandButton2_Click()
-    Call ClearWorksheetNames
-End Sub
-
-Private Sub CommandButton3_Click()
-    Call AddNewWorksheet
-End Sub
-
-Private Sub Worksheet_Activate()
-    MsgBox "This pop-up message is displayed whenever this worksheet is activated."
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3, 3, 2, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    Call SelectToFromCells
-End Sub
-
-Private Sub CommandButton2_Click()
-    Call RotateMatrix
-End Sub
-
-Private Sub CommandButton3_Click()
-    Call ElementOperations
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Not (Intersect(Target, Range("MyCell")) Is Nothing) Then
-        Select Case LCase(Target.Value)
-            Case "a", "e", "i", "o", "u"
-                Range("MsgCell").Value = "vowel"
-                
-            Case "b" To "d", "f" To "h", "j" To "n", "p" To "t", "v" To "z"
-                Range("MsgCell").Value = "consonant"
-            
-            Case 0 To 9
-                Range("MsgCell").Value = "number"
-                
-            Case Else
-                Range("MsgCell").Value = "unknown"
-        End Select
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-WorksheetsVBACode
->>>>>>
-Attribute VB_Name = "WorksheetsVBACode"
-Sub AddNewWorksheet()
-    Dim wksh As Worksheet
-    
-    Set wksh = Worksheets.Add
-    wksh.Name = "MyNewSheet"
-End Sub
-Sub ListAllWorksheets()
-    Dim wksh As Worksheet
-    Dim i As Integer
-    
-    With Range("WkShNames")
-        i = 1
-        For Each wksh In ActiveWorkbook.Worksheets
-            .Cells(i).Value = wksh.Name
-            i = i + 1
-        Next
-    End With
-
-End Sub
-
-Sub ClearWorksheetNames()
-    Dim YesNoResponse As Integer
-    
-    Range("WkShNameArea").Select
-    
-    YesNoResponse = MsgBox("Clear Worksheet Name Area?", vbYesNo)
-    
-    If YesNoResponse = vbYes Then
-        Range("WkShNameArea").ClearContents
-
-    End If
-    
-    Range("a1").Select
-End Sub
-<<<<<<
-======================
-CellVBACode
->>>>>>
-Attribute VB_Name = "CellVBACode"
-Sub SelectToFromCells()
-    Range("FromCell", "ToCell").Select
-End Sub
-
-Sub RotateMatrix()
-    Dim i As Integer, j As Integer
-    Dim Temp As Variant
-    
-    With Range("MyMatrix")
-        Temp = .Cells(2, 1)
-        .Cells(2, 1) = .Cells(2, 2)
-        .Cells(2, 2) = .Cells(1, 2)
-        .Cells(1, 2) = .Cells(1, 1)
-        .Cells(1, 1) = Temp
-    End With
-End Sub
-
-
-Sub ElementOperations()
-    Dim i As Integer
-    Dim NumberOfElements As Integer
-    Dim ElementProduct As Double
-    Dim ElementSum As Double
-    
-    With Range("MyVector")
-        NumberOfElements = .Rows.Count
-        ElementProduct = 1
-        ElementSum = 0
-        For i = 1 To NumberOfElements
-            ElementProduct = ElementProduct * .Cells(i)
-            ElementSum = ElementSum + .Cells(i)
-        Next i
-    End With
-
-    Range("ElementProduct").Value = ElementProduct
-    Range("ElementSum").Value = ElementSum
-End Sub
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3, 3, 2, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton4, 5, 4, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton5, 6, 5, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    Call getApplProperties
-End Sub
-
-Private Sub CommandButton2_Click()
-    Call generateDataToSort
-End Sub
-
-Private Sub CommandButton3_Click()
-    Call SortWithScreenUpdating
-End Sub
-
-Private Sub CommandButton4_Click()
-    Call SortWithNoScreenUpdating
-End Sub
-
-Private Sub CommandButton5_Click()
-    Call generateDataToSort
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("ApplProperties").ClearContents
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-ApplicationCode
->>>>>>
-Attribute VB_Name = "ApplicationCode"
-'''
-''' Contains various VBA coding examples on accessing the Application Object
-'''
-Option Explicit
-
-
-Sub getApplProperties()
-    Range("ApplParent") = Application.Parent
-    Range("ApplPath") = Application.Path
-    Range("ApplActiveWorkbook") = Application.ActiveWorkbook.Name
-    Range("ApplActiveSheet") = Application.ActiveSheet.Name
-    Range("ApplActiveCell") = Application.ActiveCell.Address
-    
-End Sub
-
-
-Sub generateDataToSort()
-    Dim i As Integer
-    
-    With Range("SortArray")
-        For i = 1 To .Rows.Count
-            .Cells(i) = Int((100 * Rnd) + 1)    ' Generate random value between 1 and 100.
-        Next i
-    End With
-
-End Sub
-
-Sub SortWithScreenUpdating()
-    Application.ScreenUpdating = True
-    Call BubbleSort(Range("SortArray"))
-    Range("SortArray").Select
-    MsgBox "Sorting Completed"
-End Sub
-Sub SortWithNoScreenUpdating()
-    Application.ScreenUpdating = False
-    Call BubbleSort(Range("SortArray"))
-    Range("SortArray").Select
-    Application.ScreenUpdating = True
-    MsgBox "Sorting Completed"
-End Sub
-
-Sub BubbleSort(rngToSort As Range)
-    Dim i, j As Integer
-    Dim Temp As Variant
-
-    With rngToSort
-        For j = .Rows.Count To 1 Step -1
-            For i = 1 To j
-                .Cells(i).Interior.ColorIndex = 6
-                .Cells(j).Interior.ColorIndex = 8
-                Application.Wait (Now + TimeValue("0:00:01"))
-                If .Cells(i) > .Cells(j) Then
-                    Temp = .Cells(i)
-                    .Cells(i) = .Cells(j)
-                    .Cells(j) = Temp
-                End If
-                .Cells(i).Interior.ColorIndex = xlColorIndexNone
-                .Cells(j).Interior.ColorIndex = xlColorIndexNone
-            Next i
-        Next j
-    
-    End With
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Macro1()
-Attribute Macro1.VB_Description = "Macro recorded 5/5/2004 by Jim Thompson"
-Attribute Macro1.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro1 Macro
-' Macro recorded 5/5/2004 by Jim Thompson
-'
-
-'
-    Selection.End(xlDown).Select
-End Sub
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'Controls'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-
-Private Sub CommandButton1_Click()
-ActiveSheet.Next.Select
-Rem Range("A1").Select - broken for some stupid reason
-Rem Selection.Copy
-Rem If Selection.EntireRow.Hidden = False Then
-Rem     MsgBox ("Selection Error")
-Rem End If
-ActiveSheet.Previous.Select
-End Sub
-<<<<<<
-======================
-Invocations
->>>>>>
-Attribute VB_Name = "Invocations"
-Rem       No defined return value
-
-Function INoReturnNoRet()
-End Function
-Function IGetThreeNoRet()
-IGetThreeNoRet = 3
-End Function
-Function IGetFooNoRet()
-IGetFooNoRet = "foo"
-End Function
-Function IGetPINoRet()
-IGetPINoRet = 3.1415926535898
-End Function
-
-Rem       Various return types
-
-Function IGetInteger() As Integer
-IGetInteger = 42
-End Function
-Function IGetString() As String
-IGetString = "baa"
-End Function
-Function IGetDouble() As Double
-IGetDouble = 3.1415926535898
-End Function
-Function IGetSingle() As Single
-IGetSingle = 23
-End Function
-Function IGetBoolean() As Boolean
-IGetBoolean = True
-End Function
-
-Rem       Misc parameter types
-
-Function TakesNothing()
-TakesNothing = 1
-End Function
-Function TakesInteger(arg As Integer) As Integer
-TakesInteger = 21
-End Function
-Function TakesString(arg As String) As Integer
-TakesString = 17
-End Function
-Function TakesDouble(arg As Double) As Integer
-TakesDouble = 38
-End Function
-Function TakesDate(arg As Date) As Integer
-TakesDate = 23
-End Function
-Function TakesRange(arg As Range) As Integer
-TakesRange = 11
-End Function
-
-
-Rem Optional arguments
-Function OptionalArgument(Length As Integer, Optional Width As Variant) As Integer
-If IsMissing(Width) Then
-    OptionalArgument = Length * Length
-Else
-    OptionalArgument = Length * Width
-End If
-End Function
-
-Function OptionalNonVariant(Optional IsZero As Integer) As Integer
-If IsMissing(IsZero) Then
-Rem This never occurs
-    OptionalNonVariant = 23
-Else
-    OptionalNonVariant = 17
-End If
-End Function
-
-<<<<<<
-======================
-ObjectModel
->>>>>>
-Attribute VB_Name = "ObjectModel"
-Function ObjectWorksheetFn() As Double
-ObjectWorksheetFn = WorksheetFunction.Sinh(2.3)
-End Function
-Function ObjectIsVolatile() As Double
-Application.Volatile
-ObjectIsVolatile = 3
-End Function
-Function ObjectRange(a As Range) As Integer
-ObjectRange = a.Column + a.Row + a.Height + a.Width
-End Function
-<<<<<<
-======================
-Syntax
->>>>>>
-Attribute VB_Name = "Syntax"
-Rem       Basic Statements
-Function StmtIf() As Boolean
-Dim bIf As Boolean
-bIf = True
-If bIf Then StmtIf = True
-If Not bIf Then
-    StmtIf = False
-Else
-    StmtIf = True
-End If
-End Function
-Function StmtSel() As Boolean
-Dim Digit As Integer
-Select Case Digit
-    Case 0
-        StmtSel = True
-    Case 1
-        StmtSel = False
-End Select
-End Function
-Function StmtFor() As Integer
-Dim i As Integer
-Dim j As Integer
-For i = 0 To 10
-    j = j + i
-Next i
-StmtFor = j
-End Function
-Function StmtForEach() As Integer
-Dim i(3)
-Dim j As Variant
-Dim c As Integer
-i(1) = "1"
-i(2) = Now
-i(3) = "1"
-For Each j In i()
-    c = c + 1
-Next j
-StmtForEach = c
-End Function
-Function StmtWhile() As Integer
-Dim i As Integer
-While i < 11
-    i = i + 1
-Wend
-StmtWhile = i
-End Function
-Function StmtWith() As Integer
-With Selection
-    .Orientation = 0
-End With
-StmtWith = 15
-End Function
-
-Rem       Unary Operators
-Function UnaryNot() As Boolean
-UnaryNot = Not False
-End Function
-
-Rem       Comparison Operators
-Function BinaryIsGreater() As Boolean
-BinaryIsGreater = 3 > 2
-End Function
-Function BinaryIsGreaterEqual() As Boolean
-BinaryIsGreaterEqual = 2 >= 2
-End Function
-Function BinaryIsLess() As Boolean
-BinaryIsLess = 2 < 2
-End Function
-Function BinaryIsLessEqual() As Boolean
-BinaryIsLessEqual = 4 <= 4
-End Function
-Function BinaryIsEqual() As Boolean
-BinaryIsEqual = 4 = 4
-End Function
-
-Rem       Arithmetic Operators
-Function BinaryExp() As Integer
-BinaryExp = 10 ^ 2
-End Function
-Function BinaryAdd() As Integer
-BinaryAdd = 2 + 3
-End Function
-Function BinarySub() As Integer
-BinarySub = 5 - 7
-End Function
-Function BinaryMult() As Integer
-BinaryMult = 2 * 7
-End Function
-Function BinaryDivide() As Integer
-BinaryDivide = 17 / 6
-End Function
-Function RShift() As Integer
-' RShift = 10 << 1
-End Function
-Function LShift() As Integer
-' LShift = 10 >> 1
-End Function
-
-<<<<<<
-======================
-RecordedMacros
->>>>>>
-Attribute VB_Name = "RecordedMacros"
-Sub Boldify()
-Attribute Boldify.VB_Description = "Macro recorded 20/04/2004 by Michael"
-Attribute Boldify.VB_ProcData.VB_Invoke_Func = "t\n14"
-'
-' Boldify Macro
-' Macro recorded 20/04/2004 by Michael
-'
-' Keyboard Shortcut: Ctrl+t
-'
-    Selection.Font.Bold = True
-End Sub
-Sub Italicize()
-Attribute Italicize.VB_Description = "Second Macro description"
-Attribute Italicize.VB_ProcData.VB_Invoke_Func = "J\n14"
-'
-' Italicize Macro
-' Second Macro description
-'
-' Keyboard Shortcut: Ctrl+Shift+J
-'
-    Selection.Font.Italic = True
-End Sub
-Sub Complex()
-Attribute Complex.VB_Description = "Daft thing ..."
-Attribute Complex.VB_ProcData.VB_Invoke_Func = "C\n14"
-'
-' Complex Macro
-' Daft thing ...
-'
-' Keyboard Shortcut: Ctrl+Shift+C
-'
-    ActiveCell.FormulaR1C1 = "2"
-    Range("F8").Select
-    ActiveCell.FormulaR1C1 = "3"
-    Range("F9").Select
-    Selection.Font.Bold = True
-    ActiveCell.FormulaR1C1 = "5"
-    Range("F10").Select
-    ActiveCell.FormulaR1C1 = "=R[-3]C+R[-1]C"
-    Range("F11").Select
-    With Selection.Font
-        .Name = "Arial Black"
-        .Size = 10
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveCell.FormulaR1C1 = "Arial Black"
-    Range("F12").Select
-    ActiveCell.FormulaR1C1 = "Centered"
-    Range("F13").Select
-    ActiveCell.FormulaR1C1 = "Left"
-    Range("F14").Select
-    ActiveCell.FormulaR1C1 = "Right"
-    Range("F12").Select
-    With Selection
-        .HorizontalAlignment = xlCenter
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Range("F13").Select
-    With Selection
-        .HorizontalAlignment = xlLeft
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Range("F14").Select
-    With Selection
-        .HorizontalAlignment = xlRight
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Range("F15:G15").Select
-    ActiveCell.FormulaR1C1 = "Joiined"
-    Range("F15:G15").Select
-    Range("G15").Activate
-    With Selection
-        .HorizontalAlignment = xlCenter
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Selection.Merge
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Constants
->>>>>>
-Attribute VB_Name = "Constants"
-Rem  *****  BASIC  *****
-    
-Function vbUseCompareOptionConst() As Double
-    vbUseCompareOptionConst = vbUseCompareOption
-End Function
-Function vbBinaryCompareConst() As Double
-    vbBinaryCompareConst = vbBinaryCompare
-End Function
-Function vbTextCompareConst() As Double
-    vbTextCompareConst = vbTextCompare
-End Function
-Function vbDatabaseCompareConst() As Double
-    vbDatabaseCompareConst = vbDatabaseCompare
-End Function
-Function vbSundayConst() As Double
-    vbSundayConst = vbSunday
-End Function
-Function vbMondayConst() As Double
-    vbMondayConst = vbMonday
-End Function
-Function vbTuesdayConst() As Double
-    vbTuesdayConst = vbTuesday
-End Function
-Function vbWednesdayConst() As Double
-    vbWednesdayConst = vbWednesday
-End Function
-Function vbThursdayConst() As Double
-    vbThursdayConst = vbThursday
-End Function
-Function vbFridayConst() As Double
-    vbFridayConst = vbFriday
-End Function
-Function vbSaturdayConst() As Double
-    vbSaturdayConst = vbSaturday
-End Function
-Function vbUseSystemConst() As Double
-    vbUseSystemConst = vbUseSystem
-End Function
-Function vbGeneralDateConst() As Double
-    vbGeneralDateConst = vbGeneralDate
-End Function
-Function vbLongDateConst() As Double
-    vbLongDateConst = vbLongDate
-End Function
-Function vbShortDateConst() As Double
-    vbShortDateConst = vbShortDate
-End Function
-Function vbLongTimeConst() As Double
-    vbLongTimeConst = vbLongTime
-End Function
-Function vbShortTimeConst() As Double
-    vbShortTimeConst = vbShortTime
-End Function
-Function vbObjectErrorConst() As Double
-    vbObjectErrorConst = vbObjectError
-End Function
-Function vbOKOnlyConst() As Double
-    vbOKOnlyConst = vbOKOnly
-End Function
-Function vbOKCancelConst() As Double
-    vbOKCancelConst = vbOKCancel
-End Function
-Function vbAbortRetryIgnoreConst() As Double
-    vbAbortRetryIgnoreConst = vbAbortRetryIgnore
-End Function
-Function vbYesNoCancelConst() As Double
-    vbYesNoCancelConst = vbYesNoCancel
-End Function
-Function vbYesNoConst() As Double
-    vbYesNoConst = vbYesNo
-End Function
-Function vbRetryCancelConst() As Double
-    vbRetryCancelConst = vbRetryCancel
-End Function
-Function vbCriticalConst() As Double
-    vbCriticalConst = vbCritical
-End Function
-Function vbQuestionConst() As Double
-    vbQuestionConst = vbQuestion
-End Function
-Function vbExclamationConst() As Double
-    vbExclamationConst = vbExclamation
-End Function
-Function vbInformationConst() As Double
-    vbInformationConst = vbInformation
-End Function
-Function vbDefaultButton1Const() As Double
-    vbDefaultButton1Const = vbDefaultButton1
-End Function
-Function vbDefaultButton2Const() As Double
-    vbDefaultButton2Const = vbDefaultButton2
-End Function
-Function vbDefaultButton3Const() As Double
-    vbDefaultButton3Const = vbDefaultButton3
-End Function
-Function vbDefaultButton4Const() As Double
-    vbDefaultButton4Const = vbDefaultButton4
-End Function
-Function vbApplicationModalConst() As Double
-    vbApplicationModalConst = vbApplicationModal
-End Function
-Function vbSystemModalConst() As Double
-    vbSystemModalConst = vbSystemModal
-End Function
-Function vbMsgBoxHelpButtonConst() As Double
-    vbMsgBoxHelpButtonConst = vbMsgBoxHelpButton
-End Function
-Function vbMsgBoxSetForegroundConst() As Double
-    vbMsgBoxSetForegroundConst = vbMsgBoxSetForeground
-End Function
-Function vbMsgBoxRightConst() As Double
-    vbMsgBoxRightConst = vbMsgBoxRight
-End Function
-Function vbMsgBoxRtlReadingConst() As Double
-    vbMsgBoxRtlReadingConst = vbMsgBoxRtlReading
-End Function
-
-<<<<<<
-======================
-Constants1
->>>>>>
-Attribute VB_Name = "Constants1"
-Rem  *****  BASIC  *****
-    
-Function vbCrConst() As String
-    vbCrConst = vbCr
-End Function
-Function VbCrLfConst() As String
-    VbCrLfConst = vbCrLf
-End Function
-Function vbFormFeedConst() As String
-    vbFormFeedConst = vbFormFeed
-End Function
-Function vbLfConst() As String
-    vbLfConst = vbLf
-End Function
-Function vbNewLineConst() As String
-    vbNewLineConst = vbNewLine
-End Function
-Function vbNullCharConst() As String
-    vbNullCharConst = vbNullChar
-End Function
-Function vbNullStringConst() As String
-    vbNullStringConst = vbNullString
-End Function
-Function vbTabConst() As String
-    vbTabConst = vbTab
-End Function
-Function vbVerticalTabConst() As String
-    vbVerticalTabConst = vbVerticalTab
-End Function
-Function vbUpperCaseConst() As Integer
-    vbUpperCaseConst = vbUpperCase
-End Function
-Function vbLowerCaseConst() As Integer
-    vbLowerCaseConst = vbLowerCase
-End Function
-Function vbProperCaseConst() As Integer
-    vbProperCaseConst = vbProperCase
-End Function
-Function vbWideConst() As Integer
-    vbWideConst = vbWide
-End Function
-Function vbNarrowConst() As Integer
-    vbNarrowConst = vbNarrow
-End Function
-Function vbKatakanaConst() As Integer
-    vbKatakanaConst = vbKatakana
-End Function
-Function vbHiraganaConst() As Integer
-    vbHiraganaConst = vbHiragana
-End Function
-Function vbUnicodeConst() As Integer
-    vbUnicodeConst = vbUnicode
-End Function
-Function vbFromUnicodeConst() As Integer
-    vbFromUnicodeConst = vbFromUnicode
-End Function
-Function vbUseDefaultConst() As String
-    vbUseDefaultConst = vbUseDefault
-End Function
-Function vbTrueConst() As String
-    vbTrueConst = vbTrue
-End Function
-Function vbFalseConst() As String
-    vbFalseConst = vbFalse
-End Function
-Function vbEmptyConst() As Double
-    vbEmptyConst = vbEmpty
-End Function
-Function vbNullConst() As Double
-    vbNullConst = vbNull
-End Function
-Function vbIntegerConst() As Double
-    vbIntegerConst = vbInteger
-End Function
-Function vbLongConst() As Double
-    vbLongConst = vbLong
-End Function
-Function vbSingleConst() As Double
-    vbSingleConst = vbSingle
-End Function
-Function vbDoubleConst() As Double
-    vbDoubleConst = vbDouble
-End Function
-Function vbCurrencyConst() As Double
-    vbCurrencyConst = vbCurrency
-End Function
-Function vbDateConst() As Double
-    vbDateConst = vbDate
-End Function
-Function vbStringConst() As Double
-    vbStringConst = vbString
-End Function
-Function vbObjectConst() As Double
-    vbObjectConst = vbObject
-End Function
-Function vbErrorConst() As Double
-    vbErrorConst = vbError
-End Function
-Function vbBooleanConst() As Double
-    vbBooleanConst = vbBoolean
-End Function
-Function vbVariantConst() As Double
-    vbVariantConst = vbVariant
-End Function
-Function vbDataObjectConst() As Double
-    vbDataObjectConst = vbDataObject
-End Function
-Function vbDecimalConst() As Double
-    vbDecimalConst = vbDecimal
-End Function
-Function vbByteConst() As Double
-    vbByteConst = vbByte
-End Function
-Function vbUserDefinedTypeConst() As Double
-    vbUserDefinedTypeConst = vbUserDefinedType
-End Function
-Function vbArrayConst() As Double
-    vbArrayConst = vbArray
-End Function
-
-<<<<<<
-======================
-FunctionA_E
->>>>>>
-Attribute VB_Name = "FunctionA_E"
-Rem  *****  BASIC  *****
-    
-Function rtl_abs() As Double
-    rtl_abs = Abs(-53)
-End Function
-Function rtl_array() As Variant
-    rtl_array = Array(10, 20, 30)
-End Function
-Function rtl_asc() As Integer
-    rtl_asc = Asc("A")
-End Function
-Function rtl_atn() As Double
-    rtl_atn = Atn(3.14 / 4)
-End Function
-Function rtl_callbyname()
-End Function
-Function rtl_choose()
-   rtl_choose = Choose(1, "Choose", "Error", "Error")
-End Function
-Function rtl_chr() As String
-    rtl_chr = Chr(65)
-End Function
-Function rtl_command()
-End Function
-Function rtl_cos() As Double
-    rtl_cos = Cos(0)
-End Function
-Function rtl_createobject()
-End Function
-Function rtl_curdir() As String
-    rtl_curdir = CurDir()
-End Function
-Function rtl_cverr()
-End Function
-Function rtl_date() As Date
-    rtl_date = Date
-End Function
-Function rtl_dateadd() As Double
-    Dim myDate As Date
-    myDate = "08/10/2004"
-    rtl_dateadd = DateAdd("yyyy", 1, myDate)
-End Function
-Function rtl_datediff() As Long
-    Dim myDate As Date
-    myDate = "08/10/2004"
-    rtl_datediff = DateDiff("d", "08/01/2004", myDate)
-End Function
-Function rtl_datepart() As Integer
-    Dim myDate As Date
-    myDate = "08/10/2004"
-    rtl_datepart = DatePart("q", myDate)
-End Function
-Function rtl_dateserial() As Date
-    Dim myDate As Date
-    myDate = "08/10/2004"
-    rtl_dateserial = DateSerial(2004, 8, 10)
-End Function
-Function rtl_datevalue() As Date
-    Dim myDate As Date
-    rtl_datevalue = DateValue("12/02/1969")
-End Function
-Function rtl_day() As Integer
-    Dim myDate As Date
-    myDate = "08/10/2004"
-    rtl_day = Day(myDate)
-End Function
-Function rtl_ddb() As Integer
-End Function
-Function rtl_dir() As String
-    rtl_dir = Dir(CurDir())
-End Function
-Function rtl_doevents()
-End Function
-Function rtl_environ() As String
-    rtl_environ = Environ(1)
-End Function
-Function rtl_eof()
-End Function
-Function rtl_error() As String
-    rtl_error = Error(1)
-End Function
-Function rtl_exp() As Double
-    rtl_exp = Exp(1)
-End Function
-
-<<<<<<
-======================
-FunctionF_I
->>>>>>
-Attribute VB_Name = "FunctionF_I"
-Rem  *****  BASIC  *****
-        
-Function rtl_fileattr()
-End Function
-Function rtl_filedatetime()
-End Function
-Function rtl_filelen()
-End Function
-Function rtl_filter() As String
-    Dim MyIndex() As String
-    Dim MyArray(3)
-    MyArray(0) = "Format"
-    MyArray(1) = "Filter"
-    MyArray(2) = 10
-    MyIndex() = Filter(MyArray(), "Fil")   ' MyIndex(0) contains "Monday".
-    rtl_filter = MyIndex(0)
-End Function
-Function rtl_format() As String
-    rtl_format = Format(334.9, "###0.00")   ' Returns "334.90".
-End Function
-Function rtl_formatcurrency() As String
-    rtl_formatcurrency = FormatCurrency(1000)   ' MyCurrency contains $1000.00.
-End Function
-Function rtl_FormatDateTime() As String
-    rtl_FormatDateTime = FormatDateTime("08/10/2004", vbLongDate) 'Tuesday, August 10, 2004
-End Function
-Function rtl_formatnumber() As String
-    Dim MyAngle, MySecant
-    MyAngle = 1.3   ' Define angle in radians.
-    MySecant = 1 / Cos(MyAngle)   ' Calculate secant.
-    rtl_formatnumber = FormatNumber(MySecant, 4) ' Format MySecant to four decimal places.
-End Function
-Function rtl_formatpercent() As String
-    rtl_formatpercent = FormatPercent(2 / 32) ' MyPercent contains 6.25%.
-End Function
-Function rtl_freefile()
-End Function
-Function rtl_fv()
-End Function
-Function rtl_getallsettings()
-End Function
-Function rtl_getattr()
-End Function
-Function rtl_getautoserversetting()
-End Function
-Function rtl_getobject()
-End Function
-Function rtl_getsetting()
-End Function
-Function rtl_hex() As String
-    rtl_hex = Hex(65535)
-End Function
-Function rtl_hour() As String
-    rtl_hour = Hour("12:00:00")
-End Function
-Function rtl_iif() As String
-    rtl_iif = IIf(10 > 100, "Large", "Small")
-End Function
-Function rtl_imestatus()
-End Function
-Function rtl_input()
-End Function
-Function rtl_inputbox()
-End Function
-Function rtl_instr() As Integer
-    Dim SearchString, SearchChar
-    SearchString = "XXpXXpXXPXXP"  ' String to search in.
-    SearchChar = "P"   ' Search for "P".
-        
-    ' A textual comparison starting at position 4. Returns 6.
-    rtl_instr = InStr(4, SearchString, SearchChar, 1)
-End Function
-Function rtl_instrrev() As Integer
-    Dim SearchString, SearchChar
-    SearchString = "XXpXXpXXPXXP"  ' String to search in.
-    SearchChar = "P"   ' Search for "P".
-        
-    ' returns 12
-    rtl_instrrev = InStrRev(SearchString, SearchChar)
-End Function
-Function rtl_int() As Integer
-    rtl_int = Int(7.45)
-End Function
-Function rtl_ipmt()
-End Function
-Function rtl_irr()
-End Function
-Function rtl_isarray() As Boolean
-    Dim var(3)
-    rtl_isarray = IsArray(var())
-End Function
-Function rtl_isdate() As Boolean
-    Dim var As Date
-    rtl_isdate = IsDate(var)
-End Function
-Function rtl_isempty() As Boolean
-    Dim var
-    rtl_isempty = IsEmpty(var)
-End Function
-Function rtl_iserror() As Boolean
-    Dim var As Error
-    rtl_iserror = IsError(var)
-End Function
-Function rtl_ismissing() As Boolean
-    Dim var
-    rtl_ismissing = IsMissing(var)
-End Function
-Function rtl_isnull() As Boolean
-    Dim var
-    rtl_isnull = IsNull(var)
-End Function
-Function rtl_isnumeric() As Boolean
-    Dim var As Integer
-    rtl_isnumeric = IsNumeric(var)
-End Function
-Function rtl_isobject() As Boolean
-    Dim var As Object
-    rtl_isobject = IsObject(var)
-End Function
-
-<<<<<<
-======================
-FunctionJ_R
->>>>>>
-Attribute VB_Name = "FunctionJ_R"
-Rem  *****  BASIC  *****
-        
-Function rtl_join() As String
-    Dim MyArray(3)
-    MyArray(1) = "1"
-    MyArray(2) = "1"
-    MyArray(3) = "1"
-    rtl_join = Join(MyArray())
-End Function
-Function rtl_lbound() As Integer
-    Dim MyArray(1 To 10, 5 To 15, 10 To 20)    ' Declare array variables.
-    rtl_lbound = LBound(MyArray(), 1)    ' Returns 1.
-End Function
-Function rtl_lcase() As String
-    rtl_lcase = LCase("LowerCase")
-End Function
-Function rtl_left() As String
-    rtl_left = Left("Left", 2)
-End Function
-Function rtl_len() As Long
-    rtl_len = Len("Len")
-End Function
-Function rtl_loadpicture()
-End Function
-Function rtl_loc()
-End Function
-Function rtl_lof()
-End Function
-Function rtl_log() As Double
-    rtl_log = Log(10)
-End Function
-Function rtl_ltrim() As String
-    rtl_ltrim = LTrim(" LTrim")
-End Function
-Function rtl_mid() As String
-    rtl_mid = Mid("Mid Function", 1, 3)
-End Function
-Function rtl_minute() As Integer
-    rtl_minute = Minute("12:31:45")
-End Function
-Function rtl_mirr()
-End Function
-Function rtl_month() As Integer
-    rtl_month = Month("10/08/2004")
-End Function
-Function rtl_monthname() As String
-    rtl_monthname = MonthName(10)
-End Function
-Function rtl_msgbox()
-End Function
-Function rtl_now() As Date
-    rtl_now = Now()
-End Function
-Function rtl_nper()
-End Function
-Function rtl_npv()
-End Function
-Function rtl_oct() As String
-    rtl_oct = Oct(32)
-End Function
-Function rtl_partition()
-End Function
-Function rtl_pmt()
-End Function
-Function rtl_ppmt()
-End Function
-Function rtl_pv()
-End Function
-Function rtl_qbcolor() As Long
-    rtl_qbcolor = QBColor(5)
-End Function
-Function rtl_rate()
-End Function
-Function rtl_replace() As String
-    ' A binary comparison starting at the beginning of the string.
-    rtl_replace = Replace("XXpXXPXXp", "p", "Y")
-End Function
-Function rtl_rgb() As Long
-    rtl_rgb = RGB(255, 0, 0)
-End Function
-Function rtl_right() As String
-    rtl_right = Right("right", 2)
-End Function
-Function rtl_rnd() As Single
-    rtl_rnd = Rnd(10)
-End Function
-Function rtl_round() As Single
-    rtl_round = Round(3.1415, 2)
-End Function
-
-<<<<<<
-======================
-FunctionS_Y
->>>>>>
-Attribute VB_Name = "FunctionS_Y"
-Rem  *****  BASIC  *****
-        
-Function rtl_second() As Integer
-    rtl_second = Second("12:31:45")
-End Function
-Function rtl_seek()
-End Function
-Function rtl_sgn() As Integer
-    rtl_sgn = Sgn(10)
-End Function
-Function rtl_shell() As Integer
-End Function
-Function rtl_sin() As Integer
-    rtl_sin = Sin(0)
-End Function
-Function rtl_sln()
-End Function
-Function rtl_space() As String
-    rtl_space = "4" + Space(4) + "spaces"
-End Function
-Function rtl_split()
-    rtl_split = Split("Part1 Part2 Part3")
-End Function
-Function rtl_sqr() As Double
-    rtl_sqr = Sqr(256)
-End Function
-Function rtl_str() As String
-    rtl_str = str(256)
-End Function
-Function rtl_strcomp() As Integer
-    rtl_strcomp = StrComp("strcomp", "strcomp")
-End Function
-Function rtl_strconv() As String
-    rtl_strconv = StrConv("strconv", 3)
-End Function
-Function rtl_string() As String
-    rtl_string = String(10, "s")
-End Function
-Function rtl_strreverse() As String
-    rtl_strreverse = StrReverse("reverse")
-End Function
-Function rtl_switch() As String
-    Dim str As String
-    str = "switch"
-    rtl_switch = Switch(str = "skip", "noswitch", str = "switch", "switch")
-End Function
-Function rtl_syd()
-End Function
-Function rtl_tab()
-End Function
-Function rtl_tan() As Double
-    rtl_tan = Tan(0)
-End Function
-Function rtl_time() As Date
-    rtl_time = Time()
-End Function
-Function rtl_timer() As Single
-    rtl_timer = Timer()
-End Function
-Function rtl_timeserial() As Date
-    rtl_timeserial = TimeSerial(12, 31, 45)
-End Function
-Function rtl_timevalue() As Date
-    rtl_timevalue = TimeValue("12:31:45 AM")
-End Function
-Function rtl_typename() As String
-    rtl_typename = TypeName("string")
-End Function
-Function rtl_ubound() As Integer
-    Dim MyArray(1 To 10, 5 To 15, 10 To 20)   ' Declare array variables.
-    rtl_ubound = UBound(MyArray(), 1)   ' Returns 10.
-End Function
-Function rtl_ucase() As String
-    rtl_ucase = UCase("Uppercase")
-End Function
-Function rtl_val() As Integer
-    rtl_val = Val("3.1415")
-End Function
-Function rtl_vartype() As Integer
-    rtl_vartype = VarType(10)
-End Function
-Function rtl_weekday() As Integer
-    rtl_weekday = Weekday("10/08/2004")
-End Function
-Function rtl_weekdayname() As String
-    rtl_weekdayname = WeekdayName(6)
-End Function
-Function rtl_year() As String
-    rtl_year = Year("10/08/2004")
-End Function
-
-<<<<<<
-Project Name : 'Animated Chart Example.xls'
-Quirk - duff tag length======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "ScrollBar1, 4, 1, MSForms, ScrollBar"
-Attribute VB_Control = "CommandButton1, 5, 2, MSForms, CommandButton"
-
-
-Private Sub CommandButton1_Click()
-Range("A1").Value = 0
-End Sub
-
-Private Sub ScrollBar1_Change()
-    Range("A1").Value = Range("B1").Value * 0.035
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    MsgBox "Hello your workbook name is " & Application.ActiveWorkbook.Name
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CheckBox1, 1, 0, MSForms, CheckBox"
-Attribute VB_Control = "CheckBox2, 2, 1, MSForms, CheckBox"
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "OptionButton1, 2, 1, MSForms, OptionButton"
-Attribute VB_Control = "OptionButton2, 3, 2, MSForms, OptionButton"
-Attribute VB_Control = "OptionButton3, 4, 3, MSForms, OptionButton"
-Private Sub OptionButton1_Click()
-    'blue
-    Cells.Interior.Color = RGB(0, 0, 255)
-End Sub
-
-Private Sub OptionButton2_Click()
-    'green
-    Cells.Interior.Color = RGB(0, 255, 0)
-End Sub
-
-Private Sub OptionButton3_Click()
-    'red
-    Cells.Interior.Color = RGB(255, 0, 0)
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "TextBox1, 1, 0, MSForms, TextBox"
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "ListBox1, 1, 0, MSForms, ListBox"
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "ComboBox1, 1, 0, MSForms, ComboBox"
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "ScrollBar1, 1, 0, MSForms, ScrollBar"
-Attribute VB_Control = "ScrollBar2, 2, 1, MSForms, ScrollBar"
-Attribute VB_Control = "ScrollBar3, 3, 2, MSForms, ScrollBar"
-Private Sub ScrollBar1_Change()
-    Call UpdateColor
-End Sub
-
-Private Sub ScrollBar2_Change()
-    Call UpdateColor
-End Sub
-
-Private Sub ScrollBar3_Change()
-    Call UpdateColor
-End Sub
-
-Private Sub UpdateColor()
-    Cells.Interior.Color = RGB(Range("A1"), Range("A2"), Range("A3"))
-End Sub
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "SpinButton1, 1, 0, MSForms, SpinButton"
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Private Sub Workbook_Open()
-
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "SpinButton1, 2, 0, MSForms, SpinButton"
-Attribute VB_Control = "Reset, 3, 1, MSForms, CommandButton"
-Private Sub Reset_Click()
-
-Application.ScreenUpdating = False
-
-ActiveSheet.Range("direction").Cells(1, 1).Value = 1
-ActiveSheet.Range("direction").Cells(1, 2).Value = 0
-Dim center_x As Long
-Dim center_y As Long
-With ActiveSheet.Range("board")
-    .Clear
-    .Interior.Color = RGB(0, 0, 0)
-    center_x = .Column + .Columns.Count / 2
-    center_y = .Row + .Rows.Count / 2
-End With
-With ActiveSheet.Range("position")
-    Dim pos As Long
-    For pos = 1 To .Rows.Count
-        .Cells(pos, 1).Value = center_x
-        .Cells(pos, 2).Value = center_y
-    Next pos
-    pos = .Rows.Count
-    .Cells(pos, 1).Value = center_x - 1
-    .Cells(pos, 2).Value = center_y - 1
-End With
-
-Application.ScreenUpdating = True
-
-End Sub
-
-'Sub DrawSnake(sheet As Worksheet, pos As Range)
-Sub DrawSnake(sheet As Object, pos As Object)
-Dim col As Long
-For idx = 1 To pos.Rows.Count
-    x = pos.Cells(idx, 1).Value
-    y = pos.Cells(idx, 2).Value
-    If idx = pos.Rows.Count Then
-        col = RGB(0, 0, 0)
-    Else
-        col = RGB(150, 0, 0)
-    End If
-'    MsgBox ("Set " + Str(x) + " " + Str(y) + " to " + Str(col))
-    sheet.Cells(y, x).Interior.Color = col
-'    sheet.Range("A1:IV65536").Cells(y, x).Value = col
-Next idx
-End Sub
-
-Sub MoveSnake(board As Object, ByRef x As Long, ByRef y As Long, ByRef dir_x As Long, ByRef dir_y As Long)
-
-x = x + dir_x
-y = y + dir_y
-
-' New wrapping code
-x = ((x - board.Column + board.Columns.Count) Mod board.Columns.Count) + board.Column
-y = ((y - board.Row + board.Rows.Count) Mod board.Rows.Count) + board.Row
-
-' should we change direction ? - bias for X due to non-square foos
-If (dir_x = 0 And Rnd() > 0.75) Or _
-   (dir_x <> 0 And Rnd() > 0.85) Then
-    ' Swap dirx & diry & randomly negate
-    Dim tmp As Long
-    tmp = dir_x
-    dir_x = dir_y
-    dir_y = tmp
-    If Rnd() > 0.5 Then
-        dir_x = -dir_x
-        dir_y = -dir_y
-    End If
-End If
-
-End Sub
-Private Sub SpinButton1_Change()
-
-Application.ScreenUpdating = False
-
-Dim sheet As Object
-Set sheet = ActiveSheet
-
-Dim x As Long
-Dim y As Long
-Dim dir_x As Long
-Dim dir_y As Long
-
-x = sheet.Range("position").Cells(1, 1).Value
-y = sheet.Range("position").Cells(1, 2).Value
-dir_x = sheet.Range("direction").Cells(1, 1).Value
-dir_y = sheet.Range("direction").Cells(1, 2).Value
-
-'Dim board As Range
-Dim board As Object
-Set board = sheet.Range("board")
-
-Call MoveSnake(board, x, y, dir_x, dir_y)
-
-'MsgBox ("Moved to " + Str(x) + " " + Str(y) + " to red")
-
-sheet.Range("position").Cells(1, 1).Value = x
-sheet.Range("position").Cells(1, 2).Value = y
-ActiveSheet.Range("direction").Cells(1, 1).Value = dir_x
-ActiveSheet.Range("direction").Cells(1, 2).Value = dir_y
-
-Call DrawSnake(sheet, sheet.Range("position"))
-
-sheet.Range("src").Copy (sheet.Range("dest"))
-
-Application.ScreenUpdating = True
-
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub doSnake()
-
-Dim pos As Integer
-Dim sheet As Object
-
-Set sheet = Application.Workbooks(1).Sheets(1)
-For pos = 1 To 20
-Rem  With sheet.Cells(1, b).Interior
-    sheet.Cells(1, pos).Interior.Color = RGB(123, 0, 0)
-Rem    End With
-Rem Application.Wait (Now + TimeValue("00:00:01"))
-Next pos
-
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub test()
-Sheets("sheet1").Activate
-main_1
-Sheets("sheet2").Activate
-main_2
-Sheets("sheet3").Activate
-main_3
-Sheets("sheet4").Activate
-main_4
-Sheets("sheet5").Activate
-main_5
-End Sub
-Sub main_1()
-test_xl24HourClock (xl24HourClock)
-test_xl4DigitYears (xl4DigitYears)
-test_xlAlternateArraySeparator (xlAlternateArraySeparator)
-test_xlColumnSeparator (xlColumnSeparator)
-test_xlCountryCode (xlCountryCode)
-test_xlCountrySetting (xlCountrySetting)
-test_xlCurrencyBefore (xlCurrencyBefore)
-test_xlCurrencyCode (xlCurrencyCode)
-test_xlCurrencyDigits (xlCurrencyDigits)
-test_xlCurrencyLeadingZeros (xlCurrencyLeadingZeros)
-test_xlCurrencyMinusSign (xlCurrencyMinusSign)
-test_xlCurrencyNegative (xlCurrencyNegative)
-test_xlCurrencySpaceBefore (xlCurrencySpaceBefore)
-test_xlCurrencyTrailingZeros (xlCurrencyTrailingZeros)
-test_xlDateOrder (xlDateOrder)
-test_xlDateSeparator (xlDateSeparator)
-test_xlDayCode (xlDayCode)
-test_xlDayLeadingZero (xlDayLeadingZero)
-test_xlDecimalSeparator (xlDecimalSeparator)
-test_xlGeneralFormatName (xlGeneralFormatName)
-test_xlHourCode (xlHourCode)
-test_xlLeftBrace (xlLeftBrace)
-test_xlLeftBracket (xlLeftBracket)
-test_xlListSeparator (xlListSeparator)
-test_xlLowerCaseColumnLetter (xlLowerCaseColumnLetter)
-test_xlLowerCaseRowLetter (xlLowerCaseRowLetter)
-test_xlMDY (xlMDY)
-test_xlMetric (xlMetric)
-test_xlMinuteCode (xlMinuteCode)
-test_xlMonthCode (xlMonthCode)
-test_xlMonthLeadingZero (xlMonthLeadingZero)
-test_xlMonthNameChars (xlMonthNameChars)
-test_xlNocurrencyDigits (xlNocurrencyDigits)
-test_xlNonEnglishFunctions (xlNonEnglishFunctions)
-test_xlRightBrace (xlRightBrace)
-test_xlRightBracket (xlRightBracket)
-test_xlRowSeparator (xlRowSeparator)
-test_xlSecondCode (xlSecondCode)
-test_xlThousandsSeparator (xlThousandsSeparator)
-test_xlTimeLeadingZero (xlTimeLeadingZero)
-test_xlTimeSeparator (xlTimeSeparator)
-test_xlUpperCaseColumnLetter (xlUpperCaseColumnLetter)
-test_xlUpperCaseRowLetter (xlUpperCaseRowLetter)
-test_xlWeekdayNameChars (xlWeekdayNameChars)
-test_xlYearCode (xlYearCode)
-test_xlColumnThenRow (xlColumnThenRow)
-test_xlRowThenColumn (xlRowThenColumn)
-test_xlArabicBothStrict (xlArabicBothStrict)
-test_xlArabicNone (xlArabicNone)
-test_xlArabicStrictAlefHamza (xlArabicStrictAlefHamza)
-test_xlArabicStrictFinalYaa (xlArabicStrictFinalYaa)
-test_xlArrangeStyleCascade (xlArrangeStyleCascade)
-test_xlArrangeStyleHorizontal (xlArrangeStyleHorizontal)
-test_xlArrangeStyleTiled (xlArrangeStyleTiled)
-test_xlArrangeStyleVertical (xlArrangeStyleVertical)
-test_xlArrowHeadLengthLong (xlArrowHeadLengthLong)
-test_xlArrowHeadLengthMedium (xlArrowHeadLengthMedium)
-test_xlArrowHeadLengthShort (xlArrowHeadLengthShort)
-test_xlArrowHeadStyleClosed (xlArrowHeadStyleClosed)
-test_xlArrowHeadStyleDoubleClosed (xlArrowHeadStyleDoubleClosed)
-test_xlArrowHeadStyleDoubleOpen (xlArrowHeadStyleDoubleOpen)
-test_xlArrowHeadStyleNone (xlArrowHeadStyleNone)
-test_xlArrowHeadStyleOpen (xlArrowHeadStyleOpen)
-test_xlArrowHeadWidthMedium (xlArrowHeadWidthMedium)
-test_xlArrowHeadWidthNarrow (xlArrowHeadWidthNarrow)
-test_xlArrowHeadWidthWide (xlArrowHeadWidthWide)
-test_xlFillCopy (xlFillCopy)
-test_xlFillDays (xlFillDays)
-test_xlFillDefault (xlFillDefault)
-test_xlFillFormats (xlFillFormats)
-test_xlFillMonths (xlFillMonths)
-test_xlFillSeries (xlFillSeries)
-test_xlFillValues (xlFillValues)
-test_xlFillWeekdays (xlFillWeekdays)
-test_xlFillYears (xlFillYears)
-test_xlGrowthTrend (xlGrowthTrend)
-test_xlLinearTrend (xlLinearTrend)
-test_xlAnd (xlAnd)
-test_xlBottom10Items (xlBottom10Items)
-test_xlBottom10Percent (xlBottom10Percent)
-test_xlOr (xlOr)
-test_xlTop10Items (xlTop10Items)
-test_xlTop10Percent (xlTop10Percent)
-test_xlAxisCrossesAutomatic (xlAxisCrossesAutomatic)
-test_xlAxisCrossesCustom (xlAxisCrossesCustom)
-test_xlAxisCrossesMaximum (xlAxisCrossesMaximum)
-test_xlAxisCrossesMinimum (xlAxisCrossesMinimum)
-test_xlPrimary (xlPrimary)
-test_xlSecondary (xlSecondary)
-test_xlCategory (xlCategory)
-test_xlSeriesAxis (xlSeriesAxis)
-test_xlValue (xlValue)
-Range("A1").Value = "constant name"
-Range("B1").Value = "OOo result"
-Range("C1").Value = "Excel result"
-Range("D1").Value = "Correct?"
-End Sub
-
-Function test_xl24HourClock(ByRef num)
-Range("A2").Clear
-Range("B2").Clear
-Range("C2").Clear
-Range("D2").Clear
-Range("A2").Value = "xl24HourClock"
-Range("B2").Value = 33
-Range("C2").Value = num
-B2 = Range("B2").Value
-C2 = Range("C2").Value
-If B2 = C2 Then
-Range("D2").Value = "OK"
-Else
-Range("D2").Value = "NG"
-End If
-End Function
-
-Function test_xl4DigitYears(ByRef num)
-Range("A3").Clear
-Range("B3").Clear
-Range("C3").Clear
-Range("D3").Clear
-Range("A3").Value = "xl4DigitYears"
-Range("B3").Value = 43
-Range("C3").Value = num
-B3 = Range("B3").Value
-C3 = Range("C3").Value
-If B3 = C3 Then
-Range("D3").Value = "OK"
-Else
-Range("D3").Value = "NG"
-End If
-End Function
-
-Function test_xlAlternateArraySeparator(ByRef num)
-Range("A4").Clear
-Range("B4").Clear
-Range("C4").Clear
-Range("D4").Clear
-Range("A4").Value = "xlAlternateArraySeparator"
-Range("B4").Value = 16
-Range("C4").Value = num
-B4 = Range("B4").Value
-C4 = Range("C4").Value
-If B4 = C4 Then
-Range("D4").Value = "OK"
-Else
-Range("D4").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnSeparator(ByRef num)
-Range("A5").Clear
-Range("B5").Clear
-Range("C5").Clear
-Range("D5").Clear
-Range("A5").Value = "xlColumnSeparator"
-Range("B5").Value = 14
-Range("C5").Value = num
-B5 = Range("B5").Value
-C5 = Range("C5").Value
-If B5 = C5 Then
-Range("D5").Value = "OK"
-Else
-Range("D5").Value = "NG"
-End If
-End Function
-
-Function test_xlCountryCode(ByRef num)
-Range("A6").Clear
-Range("B6").Clear
-Range("C6").Clear
-Range("D6").Clear
-Range("A6").Value = "xlCountryCode"
-Range("B6").Value = 1
-Range("C6").Value = num
-B6 = Range("B6").Value
-C6 = Range("C6").Value
-If B6 = C6 Then
-Range("D6").Value = "OK"
-Else
-Range("D6").Value = "NG"
-End If
-End Function
-
-Function test_xlCountrySetting(ByRef num)
-Range("A7").Clear
-Range("B7").Clear
-Range("C7").Clear
-Range("D7").Clear
-Range("A7").Value = "xlCountrySetting"
-Range("B7").Value = 2
-Range("C7").Value = num
-B7 = Range("B7").Value
-C7 = Range("C7").Value
-If B7 = C7 Then
-Range("D7").Value = "OK"
-Else
-Range("D7").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyBefore(ByRef num)
-Range("A8").Clear
-Range("B8").Clear
-Range("C8").Clear
-Range("D8").Clear
-Range("A8").Value = "xlCurrencyBefore"
-Range("B8").Value = 37
-Range("C8").Value = num
-B8 = Range("B8").Value
-C8 = Range("C8").Value
-If B8 = C8 Then
-Range("D8").Value = "OK"
-Else
-Range("D8").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyCode(ByRef num)
-Range("A9").Clear
-Range("B9").Clear
-Range("C9").Clear
-Range("D9").Clear
-Range("A9").Value = "xlCurrencyCode"
-Range("B9").Value = 25
-Range("C9").Value = num
-B9 = Range("B9").Value
-C9 = Range("C9").Value
-If B9 = C9 Then
-Range("D9").Value = "OK"
-Else
-Range("D9").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyDigits(ByRef num)
-Range("A10").Clear
-Range("B10").Clear
-Range("C10").Clear
-Range("D10").Clear
-Range("A10").Value = "xlCurrencyDigits"
-Range("B10").Value = 27
-Range("C10").Value = num
-B10 = Range("B10").Value
-C10 = Range("C10").Value
-If B10 = C10 Then
-Range("D10").Value = "OK"
-Else
-Range("D10").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyLeadingZeros(ByRef num)
-Range("A11").Clear
-Range("B11").Clear
-Range("C11").Clear
-Range("D11").Clear
-Range("A11").Value = "xlCurrencyLeadingZeros"
-Range("B11").Value = 40
-Range("C11").Value = num
-B11 = Range("B11").Value
-C11 = Range("C11").Value
-If B11 = C11 Then
-Range("D11").Value = "OK"
-Else
-Range("D11").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyMinusSign(ByRef num)
-Range("A12").Clear
-Range("B12").Clear
-Range("C12").Clear
-Range("D12").Clear
-Range("A12").Value = "xlCurrencyMinusSign"
-Range("B12").Value = 38
-Range("C12").Value = num
-B12 = Range("B12").Value
-C12 = Range("C12").Value
-If B12 = C12 Then
-Range("D12").Value = "OK"
-Else
-Range("D12").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyNegative(ByRef num)
-Range("A13").Clear
-Range("B13").Clear
-Range("C13").Clear
-Range("D13").Clear
-Range("A13").Value = "xlCurrencyNegative"
-Range("B13").Value = 28
-Range("C13").Value = num
-B13 = Range("B13").Value
-C13 = Range("C13").Value
-If B13 = C13 Then
-Range("D13").Value = "OK"
-Else
-Range("D13").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencySpaceBefore(ByRef num)
-Range("A14").Clear
-Range("B14").Clear
-Range("C14").Clear
-Range("D14").Clear
-Range("A14").Value = "xlCurrencySpaceBefore"
-Range("B14").Value = 36
-Range("C14").Value = num
-B14 = Range("B14").Value
-C14 = Range("C14").Value
-If B14 = C14 Then
-Range("D14").Value = "OK"
-Else
-Range("D14").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyTrailingZeros(ByRef num)
-Range("A15").Clear
-Range("B15").Clear
-Range("C15").Clear
-Range("D15").Clear
-Range("A15").Value = "xlCurrencyTrailingZeros"
-Range("B15").Value = 39
-Range("C15").Value = num
-B15 = Range("B15").Value
-C15 = Range("C15").Value
-If B15 = C15 Then
-Range("D15").Value = "OK"
-Else
-Range("D15").Value = "NG"
-End If
-End Function
-
-Function test_xlDateOrder(ByRef num)
-Range("A16").Clear
-Range("B16").Clear
-Range("C16").Clear
-Range("D16").Clear
-Range("A16").Value = "xlDateOrder"
-Range("B16").Value = 32
-Range("C16").Value = num
-B16 = Range("B16").Value
-C16 = Range("C16").Value
-If B16 = C16 Then
-Range("D16").Value = "OK"
-Else
-Range("D16").Value = "NG"
-End If
-End Function
-
-Function test_xlDateSeparator(ByRef num)
-Range("A17").Clear
-Range("B17").Clear
-Range("C17").Clear
-Range("D17").Clear
-Range("A17").Value = "xlDateSeparator"
-Range("B17").Value = 17
-Range("C17").Value = num
-B17 = Range("B17").Value
-C17 = Range("C17").Value
-If B17 = C17 Then
-Range("D17").Value = "OK"
-Else
-Range("D17").Value = "NG"
-End If
-End Function
-
-Function test_xlDayCode(ByRef num)
-Range("A18").Clear
-Range("B18").Clear
-Range("C18").Clear
-Range("D18").Clear
-Range("A18").Value = "xlDayCode"
-Range("B18").Value = 21
-Range("C18").Value = num
-B18 = Range("B18").Value
-C18 = Range("C18").Value
-If B18 = C18 Then
-Range("D18").Value = "OK"
-Else
-Range("D18").Value = "NG"
-End If
-End Function
-
-Function test_xlDayLeadingZero(ByRef num)
-Range("A19").Clear
-Range("B19").Clear
-Range("C19").Clear
-Range("D19").Clear
-Range("A19").Value = "xlDayLeadingZero"
-Range("B19").Value = 42
-Range("C19").Value = num
-B19 = Range("B19").Value
-C19 = Range("C19").Value
-If B19 = C19 Then
-Range("D19").Value = "OK"
-Else
-Range("D19").Value = "NG"
-End If
-End Function
-
-Function test_xlDecimalSeparator(ByRef num)
-Range("A20").Clear
-Range("B20").Clear
-Range("C20").Clear
-Range("D20").Clear
-Range("A20").Value = "xlDecimalSeparator"
-Range("B20").Value = 3
-Range("C20").Value = num
-B20 = Range("B20").Value
-C20 = Range("C20").Value
-If B20 = C20 Then
-Range("D20").Value = "OK"
-Else
-Range("D20").Value = "NG"
-End If
-End Function
-
-Function test_xlGeneralFormatName(ByRef num)
-Range("A21").Clear
-Range("B21").Clear
-Range("C21").Clear
-Range("D21").Clear
-Range("A21").Value = "xlGeneralFormatName"
-Range("B21").Value = 26
-Range("C21").Value = num
-B21 = Range("B21").Value
-C21 = Range("C21").Value
-If B21 = C21 Then
-Range("D21").Value = "OK"
-Else
-Range("D21").Value = "NG"
-End If
-End Function
-
-Function test_xlHourCode(ByRef num)
-Range("A22").Clear
-Range("B22").Clear
-Range("C22").Clear
-Range("D22").Clear
-Range("A22").Value = "xlHourCode"
-Range("B22").Value = 22
-Range("C22").Value = num
-B22 = Range("B22").Value
-C22 = Range("C22").Value
-If B22 = C22 Then
-Range("D22").Value = "OK"
-Else
-Range("D22").Value = "NG"
-End If
-End Function
-
-Function test_xlLeftBrace(ByRef num)
-Range("A23").Clear
-Range("B23").Clear
-Range("C23").Clear
-Range("D23").Clear
-Range("A23").Value = "xlLeftBrace"
-Range("B23").Value = 12
-Range("C23").Value = num
-B23 = Range("B23").Value
-C23 = Range("C23").Value
-If B23 = C23 Then
-Range("D23").Value = "OK"
-Else
-Range("D23").Value = "NG"
-End If
-End Function
-
-Function test_xlLeftBracket(ByRef num)
-Range("A24").Clear
-Range("B24").Clear
-Range("C24").Clear
-Range("D24").Clear
-Range("A24").Value = "xlLeftBracket"
-Range("B24").Value = 10
-Range("C24").Value = num
-B24 = Range("B24").Value
-C24 = Range("C24").Value
-If B24 = C24 Then
-Range("D24").Value = "OK"
-Else
-Range("D24").Value = "NG"
-End If
-End Function
-
-Function test_xlListSeparator(ByRef num)
-Range("A25").Clear
-Range("B25").Clear
-Range("C25").Clear
-Range("D25").Clear
-Range("A25").Value = "xlListSeparator"
-Range("B25").Value = 5
-Range("C25").Value = num
-B25 = Range("B25").Value
-C25 = Range("C25").Value
-If B25 = C25 Then
-Range("D25").Value = "OK"
-Else
-Range("D25").Value = "NG"
-End If
-End Function
-
-Function test_xlLowerCaseColumnLetter(ByRef num)
-Range("A26").Clear
-Range("B26").Clear
-Range("C26").Clear
-Range("D26").Clear
-Range("A26").Value = "xlLowerCaseColumnLetter"
-Range("B26").Value = 9
-Range("C26").Value = num
-B26 = Range("B26").Value
-C26 = Range("C26").Value
-If B26 = C26 Then
-Range("D26").Value = "OK"
-Else
-Range("D26").Value = "NG"
-End If
-End Function
-
-Function test_xlLowerCaseRowLetter(ByRef num)
-Range("A27").Clear
-Range("B27").Clear
-Range("C27").Clear
-Range("D27").Clear
-Range("A27").Value = "xlLowerCaseRowLetter"
-Range("B27").Value = 8
-Range("C27").Value = num
-B27 = Range("B27").Value
-C27 = Range("C27").Value
-If B27 = C27 Then
-Range("D27").Value = "OK"
-Else
-Range("D27").Value = "NG"
-End If
-End Function
-
-Function test_xlMDY(ByRef num)
-Range("A28").Clear
-Range("B28").Clear
-Range("C28").Clear
-Range("D28").Clear
-Range("A28").Value = "xlMDY"
-Range("B28").Value = 44
-Range("C28").Value = num
-B28 = Range("B28").Value
-C28 = Range("C28").Value
-If B28 = C28 Then
-Range("D28").Value = "OK"
-Else
-Range("D28").Value = "NG"
-End If
-End Function
-
-Function test_xlMetric(ByRef num)
-Range("A29").Clear
-Range("B29").Clear
-Range("C29").Clear
-Range("D29").Clear
-Range("A29").Value = "xlMetric"
-Range("B29").Value = 35
-Range("C29").Value = num
-B29 = Range("B29").Value
-C29 = Range("C29").Value
-If B29 = C29 Then
-Range("D29").Value = "OK"
-Else
-Range("D29").Value = "NG"
-End If
-End Function
-
-Function test_xlMinuteCode(ByRef num)
-Range("A30").Clear
-Range("B30").Clear
-Range("C30").Clear
-Range("D30").Clear
-Range("A30").Value = "xlMinuteCode"
-Range("B30").Value = 23
-Range("C30").Value = num
-B30 = Range("B30").Value
-C30 = Range("C30").Value
-If B30 = C30 Then
-Range("D30").Value = "OK"
-Else
-Range("D30").Value = "NG"
-End If
-End Function
-
-Function test_xlMonthCode(ByRef num)
-Range("A31").Clear
-Range("B31").Clear
-Range("C31").Clear
-Range("D31").Clear
-Range("A31").Value = "xlMonthCode"
-Range("B31").Value = 20
-Range("C31").Value = num
-B31 = Range("B31").Value
-C31 = Range("C31").Value
-If B31 = C31 Then
-Range("D31").Value = "OK"
-Else
-Range("D31").Value = "NG"
-End If
-End Function
-
-Function test_xlMonthLeadingZero(ByRef num)
-Range("A32").Clear
-Range("B32").Clear
-Range("C32").Clear
-Range("D32").Clear
-Range("A32").Value = "xlMonthLeadingZero"
-Range("B32").Value = 41
-Range("C32").Value = num
-B32 = Range("B32").Value
-C32 = Range("C32").Value
-If B32 = C32 Then
-Range("D32").Value = "OK"
-Else
-Range("D32").Value = "NG"
-End If
-End Function
-
-Function test_xlMonthNameChars(ByRef num)
-Range("A33").Clear
-Range("B33").Clear
-Range("C33").Clear
-Range("D33").Clear
-Range("A33").Value = "xlMonthNameChars"
-Range("B33").Value = 30
-Range("C33").Value = num
-B33 = Range("B33").Value
-C33 = Range("C33").Value
-If B33 = C33 Then
-Range("D33").Value = "OK"
-Else
-Range("D33").Value = "NG"
-End If
-End Function
-
-Function test_xlNocurrencyDigits(ByRef num)
-Range("A34").Clear
-Range("B34").Clear
-Range("C34").Clear
-Range("D34").Clear
-Range("A34").Value = "xlNocurrencyDigits"
-Range("B34").Value = 29
-Range("C34").Value = num
-B34 = Range("B34").Value
-C34 = Range("C34").Value
-If B34 = C34 Then
-Range("D34").Value = "OK"
-Else
-Range("D34").Value = "NG"
-End If
-End Function
-
-Function test_xlNonEnglishFunctions(ByRef num)
-Range("A35").Clear
-Range("B35").Clear
-Range("C35").Clear
-Range("D35").Clear
-Range("A35").Value = "xlNonEnglishFunctions"
-Range("B35").Value = 34
-Range("C35").Value = num
-B35 = Range("B35").Value
-C35 = Range("C35").Value
-If B35 = C35 Then
-Range("D35").Value = "OK"
-Else
-Range("D35").Value = "NG"
-End If
-End Function
-
-Function test_xlRightBrace(ByRef num)
-Range("A36").Clear
-Range("B36").Clear
-Range("C36").Clear
-Range("D36").Clear
-Range("A36").Value = "xlRightBrace"
-Range("B36").Value = 13
-Range("C36").Value = num
-B36 = Range("B36").Value
-C36 = Range("C36").Value
-If B36 = C36 Then
-Range("D36").Value = "OK"
-Else
-Range("D36").Value = "NG"
-End If
-End Function
-
-Function test_xlRightBracket(ByRef num)
-Range("A37").Clear
-Range("B37").Clear
-Range("C37").Clear
-Range("D37").Clear
-Range("A37").Value = "xlRightBracket"
-Range("B37").Value = 11
-Range("C37").Value = num
-B37 = Range("B37").Value
-C37 = Range("C37").Value
-If B37 = C37 Then
-Range("D37").Value = "OK"
-Else
-Range("D37").Value = "NG"
-End If
-End Function
-
-Function test_xlRowSeparator(ByRef num)
-Range("A38").Clear
-Range("B38").Clear
-Range("C38").Clear
-Range("D38").Clear
-Range("A38").Value = "xlRowSeparator"
-Range("B38").Value = 15
-Range("C38").Value = num
-B38 = Range("B38").Value
-C38 = Range("C38").Value
-If B38 = C38 Then
-Range("D38").Value = "OK"
-Else
-Range("D38").Value = "NG"
-End If
-End Function
-
-Function test_xlSecondCode(ByRef num)
-Range("A39").Clear
-Range("B39").Clear
-Range("C39").Clear
-Range("D39").Clear
-Range("A39").Value = "xlSecondCode"
-Range("B39").Value = 24
-Range("C39").Value = num
-B39 = Range("B39").Value
-C39 = Range("C39").Value
-If B39 = C39 Then
-Range("D39").Value = "OK"
-Else
-Range("D39").Value = "NG"
-End If
-End Function
-
-Function test_xlThousandsSeparator(ByRef num)
-Range("A40").Clear
-Range("B40").Clear
-Range("C40").Clear
-Range("D40").Clear
-Range("A40").Value = "xlThousandsSeparator"
-Range("B40").Value = 4
-Range("C40").Value = num
-B40 = Range("B40").Value
-C40 = Range("C40").Value
-If B40 = C40 Then
-Range("D40").Value = "OK"
-Else
-Range("D40").Value = "NG"
-End If
-End Function
-
-Function test_xlTimeLeadingZero(ByRef num)
-Range("A41").Clear
-Range("B41").Clear
-Range("C41").Clear
-Range("D41").Clear
-Range("A41").Value = "xlTimeLeadingZero"
-Range("B41").Value = 45
-Range("C41").Value = num
-B41 = Range("B41").Value
-C41 = Range("C41").Value
-If B41 = C41 Then
-Range("D41").Value = "OK"
-Else
-Range("D41").Value = "NG"
-End If
-End Function
-
-Function test_xlTimeSeparator(ByRef num)
-Range("A42").Clear
-Range("B42").Clear
-Range("C42").Clear
-Range("D42").Clear
-Range("A42").Value = "xlTimeSeparator"
-Range("B42").Value = 18
-Range("C42").Value = num
-B42 = Range("B42").Value
-C42 = Range("C42").Value
-If B42 = C42 Then
-Range("D42").Value = "OK"
-Else
-Range("D42").Value = "NG"
-End If
-End Function
-
-Function test_xlUpperCaseColumnLetter(ByRef num)
-Range("A43").Clear
-Range("B43").Clear
-Range("C43").Clear
-Range("D43").Clear
-Range("A43").Value = "xlUpperCaseColumnLetter"
-Range("B43").Value = 7
-Range("C43").Value = num
-B43 = Range("B43").Value
-C43 = Range("C43").Value
-If B43 = C43 Then
-Range("D43").Value = "OK"
-Else
-Range("D43").Value = "NG"
-End If
-End Function
-
-Function test_xlUpperCaseRowLetter(ByRef num)
-Range("A44").Clear
-Range("B44").Clear
-Range("C44").Clear
-Range("D44").Clear
-Range("A44").Value = "xlUpperCaseRowLetter"
-Range("B44").Value = 6
-Range("C44").Value = num
-B44 = Range("B44").Value
-C44 = Range("C44").Value
-If B44 = C44 Then
-Range("D44").Value = "OK"
-Else
-Range("D44").Value = "NG"
-End If
-End Function
-
-Function test_xlWeekdayNameChars(ByRef num)
-Range("A45").Clear
-Range("B45").Clear
-Range("C45").Clear
-Range("D45").Clear
-Range("A45").Value = "xlWeekdayNameChars"
-Range("B45").Value = 31
-Range("C45").Value = num
-B45 = Range("B45").Value
-C45 = Range("C45").Value
-If B45 = C45 Then
-Range("D45").Value = "OK"
-Else
-Range("D45").Value = "NG"
-End If
-End Function
-
-Function test_xlYearCode(ByRef num)
-Range("A46").Clear
-Range("B46").Clear
-Range("C46").Clear
-Range("D46").Clear
-Range("A46").Value = "xlYearCode"
-Range("B46").Value = 19
-Range("C46").Value = num
-B46 = Range("B46").Value
-C46 = Range("C46").Value
-If B46 = C46 Then
-Range("D46").Value = "OK"
-Else
-Range("D46").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnThenRow(ByRef num)
-Range("A47").Clear
-Range("B47").Clear
-Range("C47").Clear
-Range("D47").Clear
-Range("A47").Value = "xlColumnThenRow"
-Range("B47").Value = 2
-Range("C47").Value = num
-B47 = Range("B47").Value
-C47 = Range("C47").Value
-If B47 = C47 Then
-Range("D47").Value = "OK"
-Else
-Range("D47").Value = "NG"
-End If
-End Function
-
-Function test_xlRowThenColumn(ByRef num)
-Range("A48").Clear
-Range("B48").Clear
-Range("C48").Clear
-Range("D48").Clear
-Range("A48").Value = "xlRowThenColumn"
-Range("B48").Value = 1
-Range("C48").Value = num
-B48 = Range("B48").Value
-C48 = Range("C48").Value
-If B48 = C48 Then
-Range("D48").Value = "OK"
-Else
-Range("D48").Value = "NG"
-End If
-End Function
-
-Function test_xlArabicBothStrict(ByRef num)
-Range("A49").Clear
-Range("B49").Clear
-Range("C49").Clear
-Range("D49").Clear
-Range("A49").Value = "xlArabicBothStrict"
-Range("B49").Value = 3
-Range("C49").Value = num
-B49 = Range("B49").Value
-C49 = Range("C49").Value
-If B49 = C49 Then
-Range("D49").Value = "OK"
-Else
-Range("D49").Value = "NG"
-End If
-End Function
-
-Function test_xlArabicNone(ByRef num)
-Range("A50").Clear
-Range("B50").Clear
-Range("C50").Clear
-Range("D50").Clear
-Range("A50").Value = "xlArabicNone"
-Range("B50").Value = 0
-Range("C50").Value = num
-B50 = Range("B50").Value
-C50 = Range("C50").Value
-If B50 = C50 Then
-Range("D50").Value = "OK"
-Else
-Range("D50").Value = "NG"
-End If
-End Function
-
-Function test_xlArabicStrictAlefHamza(ByRef num)
-Range("A51").Clear
-Range("B51").Clear
-Range("C51").Clear
-Range("D51").Clear
-Range("A51").Value = "xlArabicStrictAlefHamza"
-Range("B51").Value = 1
-Range("C51").Value = num
-B51 = Range("B51").Value
-C51 = Range("C51").Value
-If B51 = C51 Then
-Range("D51").Value = "OK"
-Else
-Range("D51").Value = "NG"
-End If
-End Function
-
-Function test_xlArabicStrictFinalYaa(ByRef num)
-Range("A52").Clear
-Range("B52").Clear
-Range("C52").Clear
-Range("D52").Clear
-Range("A52").Value = "xlArabicStrictFinalYaa"
-Range("B52").Value = 2
-Range("C52").Value = num
-B52 = Range("B52").Value
-C52 = Range("C52").Value
-If B52 = C52 Then
-Range("D52").Value = "OK"
-Else
-Range("D52").Value = "NG"
-End If
-End Function
-
-Function test_xlArrangeStyleCascade(ByRef num)
-Range("A53").Clear
-Range("B53").Clear
-Range("C53").Clear
-Range("D53").Clear
-Range("A53").Value = "xlArrangeStyleCascade"
-Range("B53").Value = 7
-Range("C53").Value = num
-B53 = Range("B53").Value
-C53 = Range("C53").Value
-If B53 = C53 Then
-Range("D53").Value = "OK"
-Else
-Range("D53").Value = "NG"
-End If
-End Function
-
-Function test_xlArrangeStyleHorizontal(ByRef num)
-Range("A54").Clear
-Range("B54").Clear
-Range("C54").Clear
-Range("D54").Clear
-Range("A54").Value = "xlArrangeStyleHorizontal"
-Range("B54").Value = -4128
-Range("C54").Value = num
-B54 = Range("B54").Value
-C54 = Range("C54").Value
-If B54 = C54 Then
-Range("D54").Value = "OK"
-Else
-Range("D54").Value = "NG"
-End If
-End Function
-
-Function test_xlArrangeStyleTiled(ByRef num)
-Range("A55").Clear
-Range("B55").Clear
-Range("C55").Clear
-Range("D55").Clear
-Range("A55").Value = "xlArrangeStyleTiled"
-Range("B55").Value = 1
-Range("C55").Value = num
-B55 = Range("B55").Value
-C55 = Range("C55").Value
-If B55 = C55 Then
-Range("D55").Value = "OK"
-Else
-Range("D55").Value = "NG"
-End If
-End Function
-
-Function test_xlArrangeStyleVertical(ByRef num)
-Range("A56").Clear
-Range("B56").Clear
-Range("C56").Clear
-Range("D56").Clear
-Range("A56").Value = "xlArrangeStyleVertical"
-Range("B56").Value = -4166
-Range("C56").Value = num
-B56 = Range("B56").Value
-C56 = Range("C56").Value
-If B56 = C56 Then
-Range("D56").Value = "OK"
-Else
-Range("D56").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadLengthLong(ByRef num)
-Range("A57").Clear
-Range("B57").Clear
-Range("C57").Clear
-Range("D57").Clear
-Range("A57").Value = "xlArrowHeadLengthLong"
-Range("B57").Value = 3
-Range("C57").Value = num
-B57 = Range("B57").Value
-C57 = Range("C57").Value
-If B57 = C57 Then
-Range("D57").Value = "OK"
-Else
-Range("D57").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadLengthMedium(ByRef num)
-Range("A58").Clear
-Range("B58").Clear
-Range("C58").Clear
-Range("D58").Clear
-Range("A58").Value = "xlArrowHeadLengthMedium"
-Range("B58").Value = -4138
-Range("C58").Value = num
-B58 = Range("B58").Value
-C58 = Range("C58").Value
-If B58 = C58 Then
-Range("D58").Value = "OK"
-Else
-Range("D58").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadLengthShort(ByRef num)
-Range("A59").Clear
-Range("B59").Clear
-Range("C59").Clear
-Range("D59").Clear
-Range("A59").Value = "xlArrowHeadLengthShort"
-Range("B59").Value = 1
-Range("C59").Value = num
-B59 = Range("B59").Value
-C59 = Range("C59").Value
-If B59 = C59 Then
-Range("D59").Value = "OK"
-Else
-Range("D59").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadStyleClosed(ByRef num)
-Range("A60").Clear
-Range("B60").Clear
-Range("C60").Clear
-Range("D60").Clear
-Range("A60").Value = "xlArrowHeadStyleClosed"
-Range("B60").Value = 3
-Range("C60").Value = num
-B60 = Range("B60").Value
-C60 = Range("C60").Value
-If B60 = C60 Then
-Range("D60").Value = "OK"
-Else
-Range("D60").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadStyleDoubleClosed(ByRef num)
-Range("A61").Clear
-Range("B61").Clear
-Range("C61").Clear
-Range("D61").Clear
-Range("A61").Value = "xlArrowHeadStyleDoubleClosed"
-Range("B61").Value = 4
-Range("C61").Value = num
-B61 = Range("B61").Value
-C61 = Range("C61").Value
-If B61 = C61 Then
-Range("D61").Value = "OK"
-Else
-Range("D61").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadStyleDoubleOpen(ByRef num)
-Range("A62").Clear
-Range("B62").Clear
-Range("C62").Clear
-Range("D62").Clear
-Range("A62").Value = "xlArrowHeadStyleDoubleOpen"
-Range("B62").Value = 5
-Range("C62").Value = num
-B62 = Range("B62").Value
-C62 = Range("C62").Value
-If B62 = C62 Then
-Range("D62").Value = "OK"
-Else
-Range("D62").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadStyleNone(ByRef num)
-Range("A63").Clear
-Range("B63").Clear
-Range("C63").Clear
-Range("D63").Clear
-Range("A63").Value = "xlArrowHeadStyleNone"
-Range("B63").Value = -4142
-Range("C63").Value = num
-B63 = Range("B63").Value
-C63 = Range("C63").Value
-If B63 = C63 Then
-Range("D63").Value = "OK"
-Else
-Range("D63").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadStyleOpen(ByRef num)
-Range("A64").Clear
-Range("B64").Clear
-Range("C64").Clear
-Range("D64").Clear
-Range("A64").Value = "xlArrowHeadStyleOpen"
-Range("B64").Value = 2
-Range("C64").Value = num
-B64 = Range("B64").Value
-C64 = Range("C64").Value
-If B64 = C64 Then
-Range("D64").Value = "OK"
-Else
-Range("D64").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadWidthMedium(ByRef num)
-Range("A65").Clear
-Range("B65").Clear
-Range("C65").Clear
-Range("D65").Clear
-Range("A65").Value = "xlArrowHeadWidthMedium"
-Range("B65").Value = -4138
-Range("C65").Value = num
-B65 = Range("B65").Value
-C65 = Range("C65").Value
-If B65 = C65 Then
-Range("D65").Value = "OK"
-Else
-Range("D65").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadWidthNarrow(ByRef num)
-Range("A66").Clear
-Range("B66").Clear
-Range("C66").Clear
-Range("D66").Clear
-Range("A66").Value = "xlArrowHeadWidthNarrow"
-Range("B66").Value = 1
-Range("C66").Value = num
-B66 = Range("B66").Value
-C66 = Range("C66").Value
-If B66 = C66 Then
-Range("D66").Value = "OK"
-Else
-Range("D66").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadWidthWide(ByRef num)
-Range("A67").Clear
-Range("B67").Clear
-Range("C67").Clear
-Range("D67").Clear
-Range("A67").Value = "xlArrowHeadWidthWide"
-Range("B67").Value = 3
-Range("C67").Value = num
-B67 = Range("B67").Value
-C67 = Range("C67").Value
-If B67 = C67 Then
-Range("D67").Value = "OK"
-Else
-Range("D67").Value = "NG"
-End If
-End Function
-
-Function test_xlFillCopy(ByRef num)
-Range("A68").Clear
-Range("B68").Clear
-Range("C68").Clear
-Range("D68").Clear
-Range("A68").Value = "xlFillCopy"
-Range("B68").Value = 1
-Range("C68").Value = num
-B68 = Range("B68").Value
-C68 = Range("C68").Value
-If B68 = C68 Then
-Range("D68").Value = "OK"
-Else
-Range("D68").Value = "NG"
-End If
-End Function
-
-Function test_xlFillDays(ByRef num)
-Range("A69").Clear
-Range("B69").Clear
-Range("C69").Clear
-Range("D69").Clear
-Range("A69").Value = "xlFillDays"
-Range("B69").Value = 5
-Range("C69").Value = num
-B69 = Range("B69").Value
-C69 = Range("C69").Value
-If B69 = C69 Then
-Range("D69").Value = "OK"
-Else
-Range("D69").Value = "NG"
-End If
-End Function
-
-Function test_xlFillDefault(ByRef num)
-Range("A70").Clear
-Range("B70").Clear
-Range("C70").Clear
-Range("D70").Clear
-Range("A70").Value = "xlFillDefault"
-Range("B70").Value = 0
-Range("C70").Value = num
-B70 = Range("B70").Value
-C70 = Range("C70").Value
-If B70 = C70 Then
-Range("D70").Value = "OK"
-Else
-Range("D70").Value = "NG"
-End If
-End Function
-
-Function test_xlFillFormats(ByRef num)
-Range("A71").Clear
-Range("B71").Clear
-Range("C71").Clear
-Range("D71").Clear
-Range("A71").Value = "xlFillFormats"
-Range("B71").Value = 3
-Range("C71").Value = num
-B71 = Range("B71").Value
-C71 = Range("C71").Value
-If B71 = C71 Then
-Range("D71").Value = "OK"
-Else
-Range("D71").Value = "NG"
-End If
-End Function
-
-Function test_xlFillMonths(ByRef num)
-Range("A72").Clear
-Range("B72").Clear
-Range("C72").Clear
-Range("D72").Clear
-Range("A72").Value = "xlFillMonths"
-Range("B72").Value = 7
-Range("C72").Value = num
-B72 = Range("B72").Value
-C72 = Range("C72").Value
-If B72 = C72 Then
-Range("D72").Value = "OK"
-Else
-Range("D72").Value = "NG"
-End If
-End Function
-
-Function test_xlFillSeries(ByRef num)
-Range("A73").Clear
-Range("B73").Clear
-Range("C73").Clear
-Range("D73").Clear
-Range("A73").Value = "xlFillSeries"
-Range("B73").Value = 2
-Range("C73").Value = num
-B73 = Range("B73").Value
-C73 = Range("C73").Value
-If B73 = C73 Then
-Range("D73").Value = "OK"
-Else
-Range("D73").Value = "NG"
-End If
-End Function
-
-Function test_xlFillValues(ByRef num)
-Range("A74").Clear
-Range("B74").Clear
-Range("C74").Clear
-Range("D74").Clear
-Range("A74").Value = "xlFillValues"
-Range("B74").Value = 4
-Range("C74").Value = num
-B74 = Range("B74").Value
-C74 = Range("C74").Value
-If B74 = C74 Then
-Range("D74").Value = "OK"
-Else
-Range("D74").Value = "NG"
-End If
-End Function
-
-Function test_xlFillWeekdays(ByRef num)
-Range("A75").Clear
-Range("B75").Clear
-Range("C75").Clear
-Range("D75").Clear
-Range("A75").Value = "xlFillWeekdays"
-Range("B75").Value = 6
-Range("C75").Value = num
-B75 = Range("B75").Value
-C75 = Range("C75").Value
-If B75 = C75 Then
-Range("D75").Value = "OK"
-Else
-Range("D75").Value = "NG"
-End If
-End Function
-
-Function test_xlFillYears(ByRef num)
-Range("A76").Clear
-Range("B76").Clear
-Range("C76").Clear
-Range("D76").Clear
-Range("A76").Value = "xlFillYears"
-Range("B76").Value = 8
-Range("C76").Value = num
-B76 = Range("B76").Value
-C76 = Range("C76").Value
-If B76 = C76 Then
-Range("D76").Value = "OK"
-Else
-Range("D76").Value = "NG"
-End If
-End Function
-
-Function test_xlGrowthTrend(ByRef num)
-Range("A77").Clear
-Range("B77").Clear
-Range("C77").Clear
-Range("D77").Clear
-Range("A77").Value = "xlGrowthTrend"
-Range("B77").Value = 10
-Range("C77").Value = num
-B77 = Range("B77").Value
-C77 = Range("C77").Value
-If B77 = C77 Then
-Range("D77").Value = "OK"
-Else
-Range("D77").Value = "NG"
-End If
-End Function
-
-Function test_xlLinearTrend(ByRef num)
-Range("A78").Clear
-Range("B78").Clear
-Range("C78").Clear
-Range("D78").Clear
-Range("A78").Value = "xlLinearTrend"
-Range("B78").Value = 9
-Range("C78").Value = num
-B78 = Range("B78").Value
-C78 = Range("C78").Value
-If B78 = C78 Then
-Range("D78").Value = "OK"
-Else
-Range("D78").Value = "NG"
-End If
-End Function
-
-Function test_xlAnd(ByRef num)
-Range("A79").Clear
-Range("B79").Clear
-Range("C79").Clear
-Range("D79").Clear
-Range("A79").Value = "xlAnd"
-Range("B79").Value = 1
-Range("C79").Value = num
-B79 = Range("B79").Value
-C79 = Range("C79").Value
-If B79 = C79 Then
-Range("D79").Value = "OK"
-Else
-Range("D79").Value = "NG"
-End If
-End Function
-
-Function test_xlBottom10Items(ByRef num)
-Range("A80").Clear
-Range("B80").Clear
-Range("C80").Clear
-Range("D80").Clear
-Range("A80").Value = "xlBottom10Items"
-Range("B80").Value = 4
-Range("C80").Value = num
-B80 = Range("B80").Value
-C80 = Range("C80").Value
-If B80 = C80 Then
-Range("D80").Value = "OK"
-Else
-Range("D80").Value = "NG"
-End If
-End Function
-
-Function test_xlBottom10Percent(ByRef num)
-Range("A81").Clear
-Range("B81").Clear
-Range("C81").Clear
-Range("D81").Clear
-Range("A81").Value = "xlBottom10Percent"
-Range("B81").Value = 6
-Range("C81").Value = num
-B81 = Range("B81").Value
-C81 = Range("C81").Value
-If B81 = C81 Then
-Range("D81").Value = "OK"
-Else
-Range("D81").Value = "NG"
-End If
-End Function
-
-Function test_xlOr(ByRef num)
-Range("A82").Clear
-Range("B82").Clear
-Range("C82").Clear
-Range("D82").Clear
-Range("A82").Value = "xlOr"
-Range("B82").Value = 2
-Range("C82").Value = num
-B82 = Range("B82").Value
-C82 = Range("C82").Value
-If B82 = C82 Then
-Range("D82").Value = "OK"
-Else
-Range("D82").Value = "NG"
-End If
-End Function
-
-Function test_xlTop10Items(ByRef num)
-Range("A83").Clear
-Range("B83").Clear
-Range("C83").Clear
-Range("D83").Clear
-Range("A83").Value = "xlTop10Items"
-Range("B83").Value = 3
-Range("C83").Value = num
-B83 = Range("B83").Value
-C83 = Range("C83").Value
-If B83 = C83 Then
-Range("D83").Value = "OK"
-Else
-Range("D83").Value = "NG"
-End If
-End Function
-
-Function test_xlTop10Percent(ByRef num)
-Range("A84").Clear
-Range("B84").Clear
-Range("C84").Clear
-Range("D84").Clear
-Range("A84").Value = "xlTop10Percent"
-Range("B84").Value = 5
-Range("C84").Value = num
-B84 = Range("B84").Value
-C84 = Range("C84").Value
-If B84 = C84 Then
-Range("D84").Value = "OK"
-Else
-Range("D84").Value = "NG"
-End If
-End Function
-
-Function test_xlAxisCrossesAutomatic(ByRef num)
-Range("A85").Clear
-Range("B85").Clear
-Range("C85").Clear
-Range("D85").Clear
-Range("A85").Value = "xlAxisCrossesAutomatic"
-Range("B85").Value = -4105
-Range("C85").Value = num
-B85 = Range("B85").Value
-C85 = Range("C85").Value
-If B85 = C85 Then
-Range("D85").Value = "OK"
-Else
-Range("D85").Value = "NG"
-End If
-End Function
-
-Function test_xlAxisCrossesCustom(ByRef num)
-Range("A86").Clear
-Range("B86").Clear
-Range("C86").Clear
-Range("D86").Clear
-Range("A86").Value = "xlAxisCrossesCustom"
-Range("B86").Value = -4114
-Range("C86").Value = num
-B86 = Range("B86").Value
-C86 = Range("C86").Value
-If B86 = C86 Then
-Range("D86").Value = "OK"
-Else
-Range("D86").Value = "NG"
-End If
-End Function
-
-Function test_xlAxisCrossesMaximum(ByRef num)
-Range("A87").Clear
-Range("B87").Clear
-Range("C87").Clear
-Range("D87").Clear
-Range("A87").Value = "xlAxisCrossesMaximum"
-Range("B87").Value = 2
-Range("C87").Value = num
-B87 = Range("B87").Value
-C87 = Range("C87").Value
-If B87 = C87 Then
-Range("D87").Value = "OK"
-Else
-Range("D87").Value = "NG"
-End If
-End Function
-
-Function test_xlAxisCrossesMinimum(ByRef num)
-Range("A88").Clear
-Range("B88").Clear
-Range("C88").Clear
-Range("D88").Clear
-Range("A88").Value = "xlAxisCrossesMinimum"
-Range("B88").Value = 4
-Range("C88").Value = num
-B88 = Range("B88").Value
-C88 = Range("C88").Value
-If B88 = C88 Then
-Range("D88").Value = "OK"
-Else
-Range("D88").Value = "NG"
-End If
-End Function
-
-Function test_xlPrimary(ByRef num)
-Range("A89").Clear
-Range("B89").Clear
-Range("C89").Clear
-Range("D89").Clear
-Range("A89").Value = "xlPrimary"
-Range("B89").Value = 1
-Range("C89").Value = num
-B89 = Range("B89").Value
-C89 = Range("C89").Value
-If B89 = C89 Then
-Range("D89").Value = "OK"
-Else
-Range("D89").Value = "NG"
-End If
-End Function
-
-Function test_xlSecondary(ByRef num)
-Range("A90").Clear
-Range("B90").Clear
-Range("C90").Clear
-Range("D90").Clear
-Range("A90").Value = "xlSecondary"
-Range("B90").Value = 2
-Range("C90").Value = num
-B90 = Range("B90").Value
-C90 = Range("C90").Value
-If B90 = C90 Then
-Range("D90").Value = "OK"
-Else
-Range("D90").Value = "NG"
-End If
-End Function
-
-Function test_xlCategory(ByRef num)
-Range("A91").Clear
-Range("B91").Clear
-Range("C91").Clear
-Range("D91").Clear
-Range("A91").Value = "xlCategory"
-Range("B91").Value = 1
-Range("C91").Value = num
-B91 = Range("B91").Value
-C91 = Range("C91").Value
-If B91 = C91 Then
-Range("D91").Value = "OK"
-Else
-Range("D91").Value = "NG"
-End If
-End Function
-
-Function test_xlSeriesAxis(ByRef num)
-Range("A92").Clear
-Range("B92").Clear
-Range("C92").Clear
-Range("D92").Clear
-Range("A92").Value = "xlSeriesAxis"
-Range("B92").Value = 3
-Range("C92").Value = num
-B92 = Range("B92").Value
-C92 = Range("C92").Value
-If B92 = C92 Then
-Range("D92").Value = "OK"
-Else
-Range("D92").Value = "NG"
-End If
-End Function
-
-Function test_xlValue(ByRef num)
-Range("A93").Clear
-Range("B93").Clear
-Range("C93").Clear
-Range("D93").Clear
-Range("A93").Value = "xlValue"
-Range("B93").Value = 2
-Range("C93").Value = num
-B93 = Range("B93").Value
-C93 = Range("C93").Value
-If B93 = C93 Then
-Range("D93").Value = "OK"
-Else
-Range("D93").Value = "NG"
-End If
-End Function
-
-<<<<<<
-======================
-Module2
->>>>>>
-Attribute VB_Name = "Module2"
-
-Sub main_2()
-test_xlBackgroundAutomatic (xlBackgroundAutomatic)
-test_xlBackgroundOpaque (xlBackgroundOpaque)
-test_xlBackgroundTransparent (xlBackgroundTransparent)
-test_xlHairline (xlHairline)
-test_xlMedium (xlMedium)
-test_xlThick (xlThick)
-test_xlThin (xlThin)
-test_xlBox (xlBox)
-test_xlConeToMax (xlConeToMax)
-test_xlConeToPoint (xlConeToPoint)
-test_xlCylinder (xlCylinder)
-test_xlPyramidToMax (xlPyramidToMax)
-test_xlPyramidToPoint (xlPyramidToPoint)
-Range("A1").Value = "constant name"
-Range("B1").Value = "OOo result"
-Range("C1").Value = "Excel result"
-Range("D1").Value = "Correct?"
-End Sub
-
-Function test_xlBackgroundAutomatic(ByRef num)
-Range("A2").Clear
-Range("B2").Clear
-Range("C2").Clear
-Range("D2").Clear
-Range("A2").Value = "xlBackgroundAutomatic"
-Range("B2").Value = -4105
-Range("C2").Value = num
-B2 = Range("B2").Value
-C2 = Range("C2").Value
-If B2 = C2 Then
-Range("D2").Value = "OK"
-Else
-Range("D2").Value = "NG"
-End If
-End Function
-
-Function test_xlBackgroundOpaque(ByRef num)
-Range("A3").Clear
-Range("B3").Clear
-Range("C3").Clear
-Range("D3").Clear
-Range("A3").Value = "xlBackgroundOpaque"
-Range("B3").Value = 3
-Range("C3").Value = num
-B3 = Range("B3").Value
-C3 = Range("C3").Value
-If B3 = C3 Then
-Range("D3").Value = "OK"
-Else
-Range("D3").Value = "NG"
-End If
-End Function
-
-Function test_xlBackgroundTransparent(ByRef num)
-Range("A4").Clear
-Range("B4").Clear
-Range("C4").Clear
-Range("D4").Clear
-Range("A4").Value = "xlBackgroundTransparent"
-Range("B4").Value = 2
-Range("C4").Value = num
-B4 = Range("B4").Value
-C4 = Range("C4").Value
-If B4 = C4 Then
-Range("D4").Value = "OK"
-Else
-Range("D4").Value = "NG"
-End If
-End Function
-
-Function test_xlHairline(ByRef num)
-Range("A5").Clear
-Range("B5").Clear
-Range("C5").Clear
-Range("D5").Clear
-Range("A5").Value = "xlHairline"
-Range("B5").Value = 1
-Range("C5").Value = num
-B5 = Range("B5").Value
-C5 = Range("C5").Value
-If B5 = C5 Then
-Range("D5").Value = "OK"
-Else
-Range("D5").Value = "NG"
-End If
-End Function
-
-Function test_xlMedium(ByRef num)
-Range("A6").Clear
-Range("B6").Clear
-Range("C6").Clear
-Range("D6").Clear
-Range("A6").Value = "xlMedium"
-Range("B6").Value = -4138
-Range("C6").Value = num
-B6 = Range("B6").Value
-C6 = Range("C6").Value
-If B6 = C6 Then
-Range("D6").Value = "OK"
-Else
-Range("D6").Value = "NG"
-End If
-End Function
-
-Function test_xlThick(ByRef num)
-Range("A7").Clear
-Range("B7").Clear
-Range("C7").Clear
-Range("D7").Clear
-Range("A7").Value = "xlThick"
-Range("B7").Value = 4
-Range("C7").Value = num
-B7 = Range("B7").Value
-C7 = Range("C7").Value
-If B7 = C7 Then
-Range("D7").Value = "OK"
-Else
-Range("D7").Value = "NG"
-End If
-End Function
-
-Function test_xlThin(ByRef num)
-Range("A8").Clear
-Range("B8").Clear
-Range("C8").Clear
-Range("D8").Clear
-Range("A8").Value = "xlThin"
-Range("B8").Value = 2
-Range("C8").Value = num
-B8 = Range("B8").Value
-C8 = Range("C8").Value
-If B8 = C8 Then
-Range("D8").Value = "OK"
-Else
-Range("D8").Value = "NG"
-End If
-End Function
-
-Function test_xlBox(ByRef num)
-Range("A9").Clear
-Range("B9").Clear
-Range("C9").Clear
-Range("D9").Clear
-Range("A9").Value = "xlBox"
-Range("B9").Value = 0
-Range("C9").Value = num
-B9 = Range("B9").Value
-C9 = Range("C9").Value
-If B9 = C9 Then
-Range("D9").Value = "OK"
-Else
-Range("D9").Value = "NG"
-End If
-End Function
-
-Function test_xlConeToMax(ByRef num)
-Range("A10").Clear
-Range("B10").Clear
-Range("C10").Clear
-Range("D10").Clear
-Range("A10").Value = "xlConeToMax"
-Range("B10").Value = 5
-Range("C10").Value = num
-B10 = Range("B10").Value
-C10 = Range("C10").Value
-If B10 = C10 Then
-Range("D10").Value = "OK"
-Else
-Range("D10").Value = "NG"
-End If
-End Function
-
-Function test_xlConeToPoint(ByRef num)
-Range("A11").Clear
-Range("B11").Clear
-Range("C11").Clear
-Range("D11").Clear
-Range("A11").Value = "xlConeToPoint"
-Range("B11").Value = 4
-Range("C11").Value = num
-B11 = Range("B11").Value
-C11 = Range("C11").Value
-If B11 = C11 Then
-Range("D11").Value = "OK"
-Else
-Range("D11").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinder(ByRef num)
-Range("A12").Clear
-Range("B12").Clear
-Range("C12").Clear
-Range("D12").Clear
-Range("A12").Value = "xlCylinder"
-Range("B12").Value = 3
-Range("C12").Value = num
-B12 = Range("B12").Value
-C12 = Range("C12").Value
-If B12 = C12 Then
-Range("D12").Value = "OK"
-Else
-Range("D12").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidToMax(ByRef num)
-Range("A13").Clear
-Range("B13").Clear
-Range("C13").Clear
-Range("D13").Clear
-Range("A13").Value = "xlPyramidToMax"
-Range("B13").Value = 2
-Range("C13").Value = num
-B13 = Range("B13").Value
-C13 = Range("C13").Value
-If B13 = C13 Then
-Range("D13").Value = "OK"
-Else
-Range("D13").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidToPoint(ByRef num)
-Range("A14").Clear
-Range("B14").Clear
-Range("C14").Clear
-Range("D14").Clear
-Range("A14").Value = "xlPyramidToPoint"
-Range("B14").Value = 1
-Range("C14").Value = num
-B14 = Range("B14").Value
-C14 = Range("C14").Value
-If B14 = C14 Then
-Range("D14").Value = "OK"
-Else
-Range("D14").Value = "NG"
-End If
-End Function
-
-<<<<<<
-======================
-Module3
->>>>>>
-Attribute VB_Name = "Module3"
-Sub main_3()
-test_xlDialogActivate (xlDialogActivate)
-test_xlDialogActiveCellFont (xlDialogActiveCellFont)
-test_xlDialogAddChartAutoformat (xlDialogAddChartAutoformat)
-test_xlDialogAddinManager (xlDialogAddinManager)
-test_xlDialogAlignment (xlDialogAlignment)
-test_xlDialogApplyNames (xlDialogApplyNames)
-test_xlDialogApplyStyle (xlDialogApplyStyle)
-test_xlDialogAppMove (xlDialogAppMove)
-test_xlDialogAppSize (xlDialogAppSize)
-test_xlDialogArrangeAll (xlDialogArrangeAll)
-test_xlDialogAssignToObject (xlDialogAssignToObject)
-test_xlDialogAssignToTool (xlDialogAssignToTool)
-test_xlDialogAttachText (xlDialogAttachText)
-test_xlDialogAttachToolbars (xlDialogAttachToolbars)
-test_xlDialogAutoCorrect (xlDialogAutoCorrect)
-test_xlDialogAxes (xlDialogAxes)
-test_xlDialogBorder (xlDialogBorder)
-test_xlDialogCalculation (xlDialogCalculation)
-test_xlDialogCellProtection (xlDialogCellProtection)
-test_xlDialogChangeLink (xlDialogChangeLink)
-test_xlDialogChartAddData (xlDialogChartAddData)
-test_xlDialogChartLocation (xlDialogChartLocation)
-test_xlDialogChartOptionDataLabelMultiple (xlDialogChartOptionDataLabelMultiple)
-test_xlDialogChartOptionDataLabels (xlDialogChartOptionDataLabels)
-test_xlDialogChartOptionDataTable (xlDialogChartOptionDataTable)
-test_xlDialogChartSourceData (xlDialogChartSourceData)
-test_xlDialogChartTrend (xlDialogChartTrend)
-test_xlDialogChartType (xlDialogChartType)
-test_xlDialogChartWizard (xlDialogChartWizard)
-test_xlDialogChechboxProperties (xlDialogChechboxProperties)
-test_xlDialogClear (xlDialogClear)
-test_xlDialogColorPalette (xlDialogColorPalette)
-test_xlDialogColumnWidth (xlDialogColumnWidth)
-test_xlDialogCombination (xlDialogCombination)
-test_xlDialogConditionalFormatting (xlDialogConditionalFormatting)
-test_xlDialogConsolidate (xlDialogConsolidate)
-test_xlDialogCopyChart (xlDialogCopyChart)
-test_xlDialogCopyPicture (xlDialogCopyPicture)
-test_xlDialogCreateList (xlDialogCreateList)
-test_xlDialogCreateNames (xlDialogCreateNames)
-test_xlDialogCreatePublisher (xlDialogCreatePublisher)
-test_xlDialogCustomizeToolbar (xlDialogCustomizeToolbar)
-test_xlDialogCustomViews (xlDialogCustomViews)
-test_xlDialogDataDelete (xlDialogDataDelete)
-test_xlDialogDataLabel (xlDialogDataLabel)
-test_xlDialogDataLabelMultiple (xlDialogDataLabelMultiple)
-test_xlDialogDataSeries (xlDialogDataSeries)
-test_xlDialogDataValidation (xlDialogDataValidation)
-test_xlDialogDefineName (xlDialogDefineName)
-test_xlDialogDefineStyle (xlDialogDefineStyle)
-test_xlDialogDeleteFormat (xlDialogDeleteFormat)
-test_xlDialogDeleteName (xlDialogDeleteName)
-test_xlDialogDemote (xlDialogDemote)
-test_xlDialogDisplay (xlDialogDisplay)
-test_xlDialogEditboxProperties (xlDialogEditboxProperties)
-test_xlDialogEditColor (xlDialogEditColor)
-test_xlDialogEditDelete (xlDialogEditDelete)
-test_xlDialogEditionOptions (xlDialogEditionOptions)
-test_xlDialogEditSeries (xlDialogEditSeries)
-test_xlDialogErrorbarX (xlDialogErrorbarX)
-test_xlDialogErrorbarY (xlDialogErrorbarY)
-test_xlDialogErrorChecking (xlDialogErrorChecking)
-test_xlDialogEvaluateFormula (xlDialogEvaluateFormula)
-test_xlDialogExternalDataProperties (xlDialogExternalDataProperties)
-test_xlDialogExtract (xlDialogExtract)
-test_xlDialogFileDelete (xlDialogFileDelete)
-test_xlDialogFileSharing (xlDialogFileSharing)
-test_xlDialogFillGroup (xlDialogFillGroup)
-test_xlDialogFillWorkGroup (xlDialogFillWorkGroup)
-test_xlDialogFilter (xlDialogFilter)
-test_xlDialogFilterAdvanced (xlDialogFilterAdvanced)
-test_xlDialogFindFile (xlDialogFindFile)
-test_xlDialogFont (xlDialogFont)
-test_xlDialogFontProperties (xlDialogFontProperties)
-test_xlDialogFormatAuto (xlDialogFormatAuto)
-test_xlDialogFormatChart (xlDialogFormatChart)
-test_xlDialogFormatCharttype (xlDialogFormatCharttype)
-test_xlDialogFormatFont (xlDialogFormatFont)
-test_xlDialogFormatLegend (xlDialogFormatLegend)
-test_xlDialogFormatMain (xlDialogFormatMain)
-test_xlDialogFormatMove (xlDialogFormatMove)
-test_xlDialogFormatNumber (xlDialogFormatNumber)
-test_xlDialogFormatOverlay (xlDialogFormatOverlay)
-test_xlDialogFormatSize (xlDialogFormatSize)
-test_xlDialogFormatText (xlDialogFormatText)
-test_xlDialogFormulaFind (xlDialogFormulaFind)
-test_xlDialogFormulaGoto (xlDialogFormulaGoto)
-test_xlDialogFormulaReplace (xlDialogFormulaReplace)
-test_xlDialogFunctionWizard (xlDialogFunctionWizard)
-test_xlDialogGallery3dArea (xlDialogGallery3dArea)
-test_xlDialogGallery3dBar (xlDialogGallery3dBar)
-test_xlDialogGallery3dColumn (xlDialogGallery3dColumn)
-test_xlDialogGallery3dLine (xlDialogGallery3dLine)
-test_xlDialogGallery3dPie (xlDialogGallery3dPie)
-test_xlDialogGallery3dSurface (xlDialogGallery3dSurface)
-test_xlDialogGalleryArea (xlDialogGalleryArea)
-test_xlDialogGalleryBar (xlDialogGalleryBar)
-test_xlDialogGalleryColumn (xlDialogGalleryColumn)
-test_xlDialogGalleryCustom (xlDialogGalleryCustom)
-test_xlDialogGalleryDoughnut (xlDialogGalleryDoughnut)
-test_xlDialogGalleryLine (xlDialogGalleryLine)
-test_xlDialogGalleryPie (xlDialogGalleryPie)
-test_xlDialogGalleryRader (xlDialogGalleryRader)
-test_xlDialogGalleryScatter (xlDialogGalleryScatter)
-test_xlDialogGoalSeek (xlDialogGoalSeek)
-test_xlDialogGridlines (xlDialogGridlines)
-test_xlDialogImportTextFile (xlDialogImportTextFile)
-test_xlDialogInsert (xlDialogInsert)
-test_xlDialogInsertHyperlink (xlDialogInsertHyperlink)
-test_xlDialogInsertNameLabel (xlDialogInsertNameLabel)
-test_xlDialogInsertObject (xlDialogInsertObject)
-test_xlDialogInsertPicture (xlDialogInsertPicture)
-test_xlDialogInsertTitle (xlDialogInsertTitle)
-test_xlDialogLabelProperties (xlDialogLabelProperties)
-test_xlDialogListboxProperties (xlDialogListboxProperties)
-test_xlDialogMacroOptions (xlDialogMacroOptions)
-test_xlDialogMailEditMailer (xlDialogMailEditMailer)
-test_xlDialogMailLogon (xlDialogMailLogon)
-test_xlDialogMailNextLetter (xlDialogMailNextLetter)
-test_xlDialogMainChart (xlDialogMainChart)
-test_xlDialogMainChartType (xlDialogMainChartType)
-test_xlDialogMenuEditor (xlDialogMenuEditor)
-test_xlDialogMove (xlDialogMove)
-test_xlDialogMyPermission (xlDialogMyPermission)
-test_xlDialogNew (xlDialogNew)
-test_xlDialogNewWebQuery (xlDialogNewWebQuery)
-test_xlDialogNote (xlDialogNote)
-test_xlDialogObjectProperties (xlDialogObjectProperties)
-test_xlDialogObjectProtection (xlDialogObjectProtection)
-test_xlDialogOpen (xlDialogOpen)
-test_xlDialogOpenLinks (xlDialogOpenLinks)
-test_xlDialogOpenMail (xlDialogOpenMail)
-test_xlDialogOpenText (xlDialogOpenText)
-test_xlDialogOptionsCalculation (xlDialogOptionsCalculation)
-test_xlDialogOptionsChart (xlDialogOptionsChart)
-test_xlDialogOptionsEdit (xlDialogOptionsEdit)
-test_xlDialogOptionsGeneral (xlDialogOptionsGeneral)
-test_xlDialogOptionsListAdd (xlDialogOptionsListAdd)
-test_xlDialogOptionsME (xlDialogOptionsME)
-test_xlDialogOptionsTransition (xlDialogOptionsTransition)
-test_xlDialogOptionsView (xlDialogOptionsView)
-test_xlDialogOutline (xlDialogOutline)
-test_xlDialogOverlay (xlDialogOverlay)
-test_xlDialogOverlayChartType (xlDialogOverlayChartType)
-test_xlDialogPageSetup (xlDialogPageSetup)
-test_xlDialogParse (xlDialogParse)
-test_xlDialogPasteNames (xlDialogPasteNames)
-test_xlDialogPasteSpecial (xlDialogPasteSpecial)
-test_xlDialogPatterns (xlDialogPatterns)
-test_xlDialogPermission (xlDialogPermission)
-test_xlDialogPhonetic (xlDialogPhonetic)
-test_xlDialogPivotCalculatedField (xlDialogPivotCalculatedField)
-test_xlDialogPivotCalculatedItem (xlDialogPivotCalculatedItem)
-test_xlDialogPivotClientServerSet (xlDialogPivotClientServerSet)
-test_xlDialogPivotFieldGroup (xlDialogPivotFieldGroup)
-test_xlDialogPivotFieldProperties (xlDialogPivotFieldProperties)
-test_xlDialogPivotFieldUngroup (xlDialogPivotFieldUngroup)
-test_xlDialogPivotShowPages (xlDialogPivotShowPages)
-test_xlDialogPivotSolveOrder (xlDialogPivotSolveOrder)
-test_xlDialogPivotTableOptions (xlDialogPivotTableOptions)
-test_xlDialogPivotTableWizard (xlDialogPivotTableWizard)
-test_xlDialogPlacement (xlDialogPlacement)
-test_xlDialogPrint (xlDialogPrint)
-test_xlDialogPrintSetup (xlDialogPrintSetup)
-test_xlDialogPrintPreview (xlDialogPrintPreview)
-test_xlDialogPromote (xlDialogPromote)
-test_xlDialogProperties (xlDialogProperties)
-test_xlDialogPropertyFields (xlDialogPropertyFields)
-test_xlDialogProtectDocument (xlDialogProtectDocument)
-test_xlDialogProtectSharing (xlDialogProtectSharing)
-test_xlDialogPublishAsWebPage (xlDialogPublishAsWebPage)
-test_xlDialogPushbuttonProperties (xlDialogPushbuttonProperties)
-test_xlDialogReplaceFont (xlDialogReplaceFont)
-test_xlDialogRoutingSlip (xlDialogRoutingSlip)
-test_xlDialogRowHeight (xlDialogRowHeight)
-test_xlDialogRun (xlDialogRun)
-test_xlDialogSaveAs (xlDialogSaveAs)
-test_xlDialogSaveCopyAs (xlDialogSaveCopyAs)
-test_xlDialogSaveNewObject (xlDialogSaveNewObject)
-test_xlDialogSaveWorkbook (xlDialogSaveWorkbook)
-test_xlDialogSaveWorkspace (xlDialogSaveWorkspace)
-test_xlDialogScale (xlDialogScale)
-test_xlDialogScenarioAdd (xlDialogScenarioAdd)
-test_xlDialogScenarioCells (xlDialogScenarioCells)
-test_xlDialogScenarioEdit (xlDialogScenarioEdit)
-test_xlDialogScenarioMerge (xlDialogScenarioMerge)
-test_xlDialogScenarioSummary (xlDialogScenarioSummary)
-test_xlDialogScrollbarProperties (xlDialogScrollbarProperties)
-test_xlDialogSearch (xlDialogSearch)
-test_xlDialogSelectSpecial (xlDialogSelectSpecial)
-test_xlDialogSendMail (xlDialogSendMail)
-test_xlDialogSeriesAxes (xlDialogSeriesAxes)
-test_xlDialogSeriesOptions (xlDialogSeriesOptions)
-test_xlDialogSeriesOrder (xlDialogSeriesOrder)
-test_xlDialogSeriesShape (xlDialogSeriesShape)
-test_xlDialogSeriesX (xlDialogSeriesX)
-test_xlDialogSeriesY (xlDialogSeriesY)
-test_xlDialogSetBackgroundPicture (xlDialogSetBackgroundPicture)
-test_xlDialogSetPrintTitles (xlDialogSetPrintTitles)
-test_xlDialogSetUpdateStatus (xlDialogSetUpdateStatus)
-test_xlDialogShowDetail (xlDialogShowDetail)
-test_xlDialogShowToolbar (xlDialogShowToolbar)
-test_xlDialogSize (xlDialogSize)
-test_xlDialogSort (xlDialogSort)
-test_xlDialogSortSpecial (xlDialogSortSpecial)
-test_xlDialogSplit (xlDialogSplit)
-test_xlDialogStandardFont (xlDialogStandardFont)
-test_xlDialogStandardWidth (xlDialogStandardWidth)
-test_xlDialogStyle (xlDialogStyle)
-test_xlDialogSubscribeTo (xlDialogSubscribeTo)
-test_xlDialogSubtotalCreate (xlDialogSubtotalCreate)
-test_xlDialogSummaryInfo (xlDialogSummaryInfo)
-test_xlDialogTable (xlDialogTable)
-test_xlDialogTabOrder (xlDialogTabOrder)
-test_xlDialogTextToColumns (xlDialogTextToColumns)
-test_xlDialogUnhide (xlDialogUnhide)
-test_xlDialogUpdateLink (xlDialogUpdateLink)
-test_xlDialogVbaInsertFile (xlDialogVbaInsertFile)
-test_xlDialogVbaMakeAddin (xlDialogVbaMakeAddin)
-test_xlDialogVbaProcedureDefinition (xlDialogVbaProcedureDefinition)
-test_xlDialogView3d (xlDialogView3d)
-test_xlDialogWebOptionsBrowsers (xlDialogWebOptionsBrowsers)
-test_xlDialogWebOptionsEncoding (xlDialogWebOptionsEncoding)
-test_xlDialogWebOptionsFiles (xlDialogWebOptionsFiles)
-test_xlDialogWebOptionsFonts (xlDialogWebOptionsFonts)
-test_xlDialogWebOptionsGeneral (xlDialogWebOptionsGeneral)
-test_xlDialogWebOptionsPictures (xlDialogWebOptionsPictures)
-test_xlDialogWindowMove (xlDialogWindowMove)
-test_xlDialogWindowSize (xlDialogWindowSize)
-test_xlDialogWorkbookAdd (xlDialogWorkbookAdd)
-test_xlDialogWorkbookCopy (xlDialogWorkbookCopy)
-test_xlDialogWorkbookInsert (xlDialogWorkbookInsert)
-test_xlDialogWorkbookMove (xlDialogWorkbookMove)
-test_xlDialogWorkbookName (xlDialogWorkbookName)
-test_xlDialogWorkbookNew (xlDialogWorkbookNew)
-test_xlDialogWorkbookOptions (xlDialogWorkbookOptions)
-test_xlDialogWorkbookProtect (xlDialogWorkbookProtect)
-test_xlDialogWorkbookTabSplit (xlDialogWorkbookTabSplit)
-test_xlDialogWorkbookUnhide (xlDialogWorkbookUnhide)
-test_xlDialogWorkgroup (xlDialogWorkgroup)
-test_xlDialogWorkspace (xlDialogWorkspace)
-test_xlDialogZoom (xlDialogZoom)
-Range("A1").Value = "constant name"
-Range("B1").Value = "OOo result"
-Range("C1").Value = "Excel result"
-Range("D1").Value = "Correct?"
-End Sub
-
-Function test_xlDialogActivate(ByRef num)
-Range("A2").Clear
-Range("B2").Clear
-Range("C2").Clear
-Range("D2").Clear
-Range("A2").Value = "xlDialogActivate"
-Range("B2").Value = 103
-Range("C2").Value = num
-B2 = Range("B2").Value
-C2 = Range("C2").Value
-If B2 = C2 Then
-Range("D2").Value = "OK"
-Else
-Range("D2").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogActiveCellFont(ByRef num)
-Range("A3").Clear
-Range("B3").Clear
-Range("C3").Clear
-Range("D3").Clear
-Range("A3").Value = "xlDialogActiveCellFont"
-Range("B3").Value = 476
-Range("C3").Value = num
-B3 = Range("B3").Value
-C3 = Range("C3").Value
-If B3 = C3 Then
-Range("D3").Value = "OK"
-Else
-Range("D3").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAddChartAutoformat(ByRef num)
-Range("A4").Clear
-Range("B4").Clear
-Range("C4").Clear
-Range("D4").Clear
-Range("A4").Value = "xlDialogAddChartAutoformat"
-Range("B4").Value = 390
-Range("C4").Value = num
-B4 = Range("B4").Value
-C4 = Range("C4").Value
-If B4 = C4 Then
-Range("D4").Value = "OK"
-Else
-Range("D4").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAddinManager(ByRef num)
-Range("A5").Clear
-Range("B5").Clear
-Range("C5").Clear
-Range("D5").Clear
-Range("A5").Value = "xlDialogAddinManager"
-Range("B5").Value = 321
-Range("C5").Value = num
-B5 = Range("B5").Value
-C5 = Range("C5").Value
-If B5 = C5 Then
-Range("D5").Value = "OK"
-Else
-Range("D5").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAlignment(ByRef num)
-Range("A6").Clear
-Range("B6").Clear
-Range("C6").Clear
-Range("D6").Clear
-Range("A6").Value = "xlDialogAlignment"
-Range("B6").Value = 43
-Range("C6").Value = num
-B6 = Range("B6").Value
-C6 = Range("C6").Value
-If B6 = C6 Then
-Range("D6").Value = "OK"
-Else
-Range("D6").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogApplyNames(ByRef num)
-Range("A7").Clear
-Range("B7").Clear
-Range("C7").Clear
-Range("D7").Clear
-Range("A7").Value = "xlDialogApplyNames"
-Range("B7").Value = 133
-Range("C7").Value = num
-B7 = Range("B7").Value
-C7 = Range("C7").Value
-If B7 = C7 Then
-Range("D7").Value = "OK"
-Else
-Range("D7").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogApplyStyle(ByRef num)
-Range("A8").Clear
-Range("B8").Clear
-Range("C8").Clear
-Range("D8").Clear
-Range("A8").Value = "xlDialogApplyStyle"
-Range("B8").Value = 212
-Range("C8").Value = num
-B8 = Range("B8").Value
-C8 = Range("C8").Value
-If B8 = C8 Then
-Range("D8").Value = "OK"
-Else
-Range("D8").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAppMove(ByRef num)
-Range("A9").Clear
-Range("B9").Clear
-Range("C9").Clear
-Range("D9").Clear
-Range("A9").Value = "xlDialogAppMove"
-Range("B9").Value = 170
-Range("C9").Value = num
-B9 = Range("B9").Value
-C9 = Range("C9").Value
-If B9 = C9 Then
-Range("D9").Value = "OK"
-Else
-Range("D9").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAppSize(ByRef num)
-Range("A10").Clear
-Range("B10").Clear
-Range("C10").Clear
-Range("D10").Clear
-Range("A10").Value = "xlDialogAppSize"
-Range("B10").Value = 171
-Range("C10").Value = num
-B10 = Range("B10").Value
-C10 = Range("C10").Value
-If B10 = C10 Then
-Range("D10").Value = "OK"
-Else
-Range("D10").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogArrangeAll(ByRef num)
-Range("A11").Clear
-Range("B11").Clear
-Range("C11").Clear
-Range("D11").Clear
-Range("A11").Value = "xlDialogArrangeAll"
-Range("B11").Value = 12
-Range("C11").Value = num
-B11 = Range("B11").Value
-C11 = Range("C11").Value
-If B11 = C11 Then
-Range("D11").Value = "OK"
-Else
-Range("D11").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAssignToObject(ByRef num)
-Range("A12").Clear
-Range("B12").Clear
-Range("C12").Clear
-Range("D12").Clear
-Range("A12").Value = "xlDialogAssignToObject"
-Range("B12").Value = 213
-Range("C12").Value = num
-B12 = Range("B12").Value
-C12 = Range("C12").Value
-If B12 = C12 Then
-Range("D12").Value = "OK"
-Else
-Range("D12").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAssignToTool(ByRef num)
-Range("A13").Clear
-Range("B13").Clear
-Range("C13").Clear
-Range("D13").Clear
-Range("A13").Value = "xlDialogAssignToTool"
-Range("B13").Value = 293
-Range("C13").Value = num
-B13 = Range("B13").Value
-C13 = Range("C13").Value
-If B13 = C13 Then
-Range("D13").Value = "OK"
-Else
-Range("D13").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAttachText(ByRef num)
-Range("A14").Clear
-Range("B14").Clear
-Range("C14").Clear
-Range("D14").Clear
-Range("A14").Value = "xlDialogAttachText"
-Range("B14").Value = 80
-Range("C14").Value = num
-B14 = Range("B14").Value
-C14 = Range("C14").Value
-If B14 = C14 Then
-Range("D14").Value = "OK"
-Else
-Range("D14").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAttachToolbars(ByRef num)
-Range("A15").Clear
-Range("B15").Clear
-Range("C15").Clear
-Range("D15").Clear
-Range("A15").Value = "xlDialogAttachToolbars"
-Range("B15").Value = 323
-Range("C15").Value = num
-B15 = Range("B15").Value
-C15 = Range("C15").Value
-If B15 = C15 Then
-Range("D15").Value = "OK"
-Else
-Range("D15").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAutoCorrect(ByRef num)
-Range("A16").Clear
-Range("B16").Clear
-Range("C16").Clear
-Range("D16").Clear
-Range("A16").Value = "xlDialogAutoCorrect"
-Range("B16").Value = 485
-Range("C16").Value = num
-B16 = Range("B16").Value
-C16 = Range("C16").Value
-If B16 = C16 Then
-Range("D16").Value = "OK"
-Else
-Range("D16").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAxes(ByRef num)
-Range("A17").Clear
-Range("B17").Clear
-Range("C17").Clear
-Range("D17").Clear
-Range("A17").Value = "xlDialogAxes"
-Range("B17").Value = 78
-Range("C17").Value = num
-B17 = Range("B17").Value
-C17 = Range("C17").Value
-If B17 = C17 Then
-Range("D17").Value = "OK"
-Else
-Range("D17").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogBorder(ByRef num)
-Range("A18").Clear
-Range("B18").Clear
-Range("C18").Clear
-Range("D18").Clear
-Range("A18").Value = "xlDialogBorder"
-Range("B18").Value = 45
-Range("C18").Value = num
-B18 = Range("B18").Value
-C18 = Range("C18").Value
-If B18 = C18 Then
-Range("D18").Value = "OK"
-Else
-Range("D18").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCalculation(ByRef num)
-Range("A19").Clear
-Range("B19").Clear
-Range("C19").Clear
-Range("D19").Clear
-Range("A19").Value = "xlDialogCalculation"
-Range("B19").Value = 32
-Range("C19").Value = num
-B19 = Range("B19").Value
-C19 = Range("C19").Value
-If B19 = C19 Then
-Range("D19").Value = "OK"
-Else
-Range("D19").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCellProtection(ByRef num)
-Range("A20").Clear
-Range("B20").Clear
-Range("C20").Clear
-Range("D20").Clear
-Range("A20").Value = "xlDialogCellProtection"
-Range("B20").Value = 46
-Range("C20").Value = num
-B20 = Range("B20").Value
-C20 = Range("C20").Value
-If B20 = C20 Then
-Range("D20").Value = "OK"
-Else
-Range("D20").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChangeLink(ByRef num)
-Range("A21").Clear
-Range("B21").Clear
-Range("C21").Clear
-Range("D21").Clear
-Range("A21").Value = "xlDialogChangeLink"
-Range("B21").Value = 166
-Range("C21").Value = num
-B21 = Range("B21").Value
-C21 = Range("C21").Value
-If B21 = C21 Then
-Range("D21").Value = "OK"
-Else
-Range("D21").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartAddData(ByRef num)
-Range("A22").Clear
-Range("B22").Clear
-Range("C22").Clear
-Range("D22").Clear
-Range("A22").Value = "xlDialogChartAddData"
-Range("B22").Value = 392
-Range("C22").Value = num
-B22 = Range("B22").Value
-C22 = Range("C22").Value
-If B22 = C22 Then
-Range("D22").Value = "OK"
-Else
-Range("D22").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartLocation(ByRef num)
-Range("A23").Clear
-Range("B23").Clear
-Range("C23").Clear
-Range("D23").Clear
-Range("A23").Value = "xlDialogChartLocation"
-Range("B23").Value = 527
-Range("C23").Value = num
-B23 = Range("B23").Value
-C23 = Range("C23").Value
-If B23 = C23 Then
-Range("D23").Value = "OK"
-Else
-Range("D23").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartOptionDataLabelMultiple(ByRef num)
-Range("A24").Clear
-Range("B24").Clear
-Range("C24").Clear
-Range("D24").Clear
-Range("A24").Value = "xlDialogChartOptionDataLabelMultiple"
-Range("B24").Value = 724
-Range("C24").Value = num
-B24 = Range("B24").Value
-C24 = Range("C24").Value
-If B24 = C24 Then
-Range("D24").Value = "OK"
-Else
-Range("D24").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartOptionDataLabels(ByRef num)
-Range("A25").Clear
-Range("B25").Clear
-Range("C25").Clear
-Range("D25").Clear
-Range("A25").Value = "xlDialogChartOptionDataLabels"
-Range("B25").Value = 505
-Range("C25").Value = num
-B25 = Range("B25").Value
-C25 = Range("C25").Value
-If B25 = C25 Then
-Range("D25").Value = "OK"
-Else
-Range("D25").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartOptionDataTable(ByRef num)
-Range("A26").Clear
-Range("B26").Clear
-Range("C26").Clear
-Range("D26").Clear
-Range("A26").Value = "xlDialogChartOptionDataTable"
-Range("B26").Value = 506
-Range("C26").Value = num
-B26 = Range("B26").Value
-C26 = Range("C26").Value
-If B26 = C26 Then
-Range("D26").Value = "OK"
-Else
-Range("D26").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartSourceData(ByRef num)
-Range("A27").Clear
-Range("B27").Clear
-Range("C27").Clear
-Range("D27").Clear
-Range("A27").Value = "xlDialogChartSourceData"
-Range("B27").Value = 540
-Range("C27").Value = num
-B27 = Range("B27").Value
-C27 = Range("C27").Value
-If B27 = C27 Then
-Range("D27").Value = "OK"
-Else
-Range("D27").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartTrend(ByRef num)
-Range("A28").Clear
-Range("B28").Clear
-Range("C28").Clear
-Range("D28").Clear
-Range("A28").Value = "xlDialogChartTrend"
-Range("B28").Value = 350
-Range("C28").Value = num
-B28 = Range("B28").Value
-C28 = Range("C28").Value
-If B28 = C28 Then
-Range("D28").Value = "OK"
-Else
-Range("D28").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartType(ByRef num)
-Range("A29").Clear
-Range("B29").Clear
-Range("C29").Clear
-Range("D29").Clear
-Range("A29").Value = "xlDialogChartType"
-Range("B29").Value = 526
-Range("C29").Value = num
-B29 = Range("B29").Value
-C29 = Range("C29").Value
-If B29 = C29 Then
-Range("D29").Value = "OK"
-Else
-Range("D29").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartWizard(ByRef num)
-Range("A30").Clear
-Range("B30").Clear
-Range("C30").Clear
-Range("D30").Clear
-Range("A30").Value = "xlDialogChartWizard"
-Range("B30").Value = 288
-Range("C30").Value = num
-B30 = Range("B30").Value
-C30 = Range("C30").Value
-If B30 = C30 Then
-Range("D30").Value = "OK"
-Else
-Range("D30").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChechboxProperties(ByRef num)
-Range("A31").Clear
-Range("B31").Clear
-Range("C31").Clear
-Range("D31").Clear
-Range("A31").Value = "xlDialogChechboxProperties"
-Range("B31").Value = 435
-Range("C31").Value = num
-B31 = Range("B31").Value
-C31 = Range("C31").Value
-If B31 = C31 Then
-Range("D31").Value = "OK"
-Else
-Range("D31").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogClear(ByRef num)
-Range("A32").Clear
-Range("B32").Clear
-Range("C32").Clear
-Range("D32").Clear
-Range("A32").Value = "xlDialogClear"
-Range("B32").Value = 52
-Range("C32").Value = num
-B32 = Range("B32").Value
-C32 = Range("C32").Value
-If B32 = C32 Then
-Range("D32").Value = "OK"
-Else
-Range("D32").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogColorPalette(ByRef num)
-Range("A33").Clear
-Range("B33").Clear
-Range("C33").Clear
-Range("D33").Clear
-Range("A33").Value = "xlDialogColorPalette"
-Range("B33").Value = 161
-Range("C33").Value = num
-B33 = Range("B33").Value
-C33 = Range("C33").Value
-If B33 = C33 Then
-Range("D33").Value = "OK"
-Else
-Range("D33").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogColumnWidth(ByRef num)
-Range("A34").Clear
-Range("B34").Clear
-Range("C34").Clear
-Range("D34").Clear
-Range("A34").Value = "xlDialogColumnWidth"
-Range("B34").Value = 47
-Range("C34").Value = num
-B34 = Range("B34").Value
-C34 = Range("C34").Value
-If B34 = C34 Then
-Range("D34").Value = "OK"
-Else
-Range("D34").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCombination(ByRef num)
-Range("A35").Clear
-Range("B35").Clear
-Range("C35").Clear
-Range("D35").Clear
-Range("A35").Value = "xlDialogCombination"
-Range("B35").Value = 73
-Range("C35").Value = num
-B35 = Range("B35").Value
-C35 = Range("C35").Value
-If B35 = C35 Then
-Range("D35").Value = "OK"
-Else
-Range("D35").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogConditionalFormatting(ByRef num)
-Range("A36").Clear
-Range("B36").Clear
-Range("C36").Clear
-Range("D36").Clear
-Range("A36").Value = "xlDialogConditionalFormatting"
-Range("B36").Value = 583
-Range("C36").Value = num
-B36 = Range("B36").Value
-C36 = Range("C36").Value
-If B36 = C36 Then
-Range("D36").Value = "OK"
-Else
-Range("D36").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogConsolidate(ByRef num)
-Range("A37").Clear
-Range("B37").Clear
-Range("C37").Clear
-Range("D37").Clear
-Range("A37").Value = "xlDialogConsolidate"
-Range("B37").Value = 191
-Range("C37").Value = num
-B37 = Range("B37").Value
-C37 = Range("C37").Value
-If B37 = C37 Then
-Range("D37").Value = "OK"
-Else
-Range("D37").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCopyChart(ByRef num)
-Range("A38").Clear
-Range("B38").Clear
-Range("C38").Clear
-Range("D38").Clear
-Range("A38").Value = "xlDialogCopyChart"
-Range("B38").Value = 147
-Range("C38").Value = num
-B38 = Range("B38").Value
-C38 = Range("C38").Value
-If B38 = C38 Then
-Range("D38").Value = "OK"
-Else
-Range("D38").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCopyPicture(ByRef num)
-Range("A39").Clear
-Range("B39").Clear
-Range("C39").Clear
-Range("D39").Clear
-Range("A39").Value = "xlDialogCopyPicture"
-Range("B39").Value = 108
-Range("C39").Value = num
-B39 = Range("B39").Value
-C39 = Range("C39").Value
-If B39 = C39 Then
-Range("D39").Value = "OK"
-Else
-Range("D39").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCreateList(ByRef num)
-Range("A40").Clear
-Range("B40").Clear
-Range("C40").Clear
-Range("D40").Clear
-Range("A40").Value = "xlDialogCreateList"
-Range("B40").Value = 769
-Range("C40").Value = num
-B40 = Range("B40").Value
-C40 = Range("C40").Value
-If B40 = C40 Then
-Range("D40").Value = "OK"
-Else
-Range("D40").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCreateNames(ByRef num)
-Range("A41").Clear
-Range("B41").Clear
-Range("C41").Clear
-Range("D41").Clear
-Range("A41").Value = "xlDialogCreateNames"
-Range("B41").Value = 62
-Range("C41").Value = num
-B41 = Range("B41").Value
-C41 = Range("C41").Value
-If B41 = C41 Then
-Range("D41").Value = "OK"
-Else
-Range("D41").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCreatePublisher(ByRef num)
-Range("A42").Clear
-Range("B42").Clear
-Range("C42").Clear
-Range("D42").Clear
-Range("A42").Value = "xlDialogCreatePublisher"
-Range("B42").Value = 217
-Range("C42").Value = num
-B42 = Range("B42").Value
-C42 = Range("C42").Value
-If B42 = C42 Then
-Range("D42").Value = "OK"
-Else
-Range("D42").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCustomizeToolbar(ByRef num)
-Range("A43").Clear
-Range("B43").Clear
-Range("C43").Clear
-Range("D43").Clear
-Range("A43").Value = "xlDialogCustomizeToolbar"
-Range("B43").Value = 276
-Range("C43").Value = num
-B43 = Range("B43").Value
-C43 = Range("C43").Value
-If B43 = C43 Then
-Range("D43").Value = "OK"
-Else
-Range("D43").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCustomViews(ByRef num)
-Range("A44").Clear
-Range("B44").Clear
-Range("C44").Clear
-Range("D44").Clear
-Range("A44").Value = "xlDialogCustomViews"
-Range("B44").Value = 493
-Range("C44").Value = num
-B44 = Range("B44").Value
-C44 = Range("C44").Value
-If B44 = C44 Then
-Range("D44").Value = "OK"
-Else
-Range("D44").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDataDelete(ByRef num)
-Range("A45").Clear
-Range("B45").Clear
-Range("C45").Clear
-Range("D45").Clear
-Range("A45").Value = "xlDialogDataDelete"
-Range("B45").Value = 36
-Range("C45").Value = num
-B45 = Range("B45").Value
-C45 = Range("C45").Value
-If B45 = C45 Then
-Range("D45").Value = "OK"
-Else
-Range("D45").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDataLabel(ByRef num)
-Range("A46").Clear
-Range("B46").Clear
-Range("C46").Clear
-Range("D46").Clear
-Range("A46").Value = "xlDialogDataLabel"
-Range("B46").Value = 379
-Range("C46").Value = num
-B46 = Range("B46").Value
-C46 = Range("C46").Value
-If B46 = C46 Then
-Range("D46").Value = "OK"
-Else
-Range("D46").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDataLabelMultiple(ByRef num)
-Range("A47").Clear
-Range("B47").Clear
-Range("C47").Clear
-Range("D47").Clear
-Range("A47").Value = "xlDialogDataLabelMultiple"
-Range("B47").Value = 723
-Range("C47").Value = num
-B47 = Range("B47").Value
-C47 = Range("C47").Value
-If B47 = C47 Then
-Range("D47").Value = "OK"
-Else
-Range("D47").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDataSeries(ByRef num)
-Range("A48").Clear
-Range("B48").Clear
-Range("C48").Clear
-Range("D48").Clear
-Range("A48").Value = "xlDialogDataSeries"
-Range("B48").Value = 40
-Range("C48").Value = num
-B48 = Range("B48").Value
-C48 = Range("C48").Value
-If B48 = C48 Then
-Range("D48").Value = "OK"
-Else
-Range("D48").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDataValidation(ByRef num)
-Range("A49").Clear
-Range("B49").Clear
-Range("C49").Clear
-Range("D49").Clear
-Range("A49").Value = "xlDialogDataValidation"
-Range("B49").Value = 525
-Range("C49").Value = num
-B49 = Range("B49").Value
-C49 = Range("C49").Value
-If B49 = C49 Then
-Range("D49").Value = "OK"
-Else
-Range("D49").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDefineName(ByRef num)
-Range("A50").Clear
-Range("B50").Clear
-Range("C50").Clear
-Range("D50").Clear
-Range("A50").Value = "xlDialogDefineName"
-Range("B50").Value = 61
-Range("C50").Value = num
-B50 = Range("B50").Value
-C50 = Range("C50").Value
-If B50 = C50 Then
-Range("D50").Value = "OK"
-Else
-Range("D50").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDefineStyle(ByRef num)
-Range("A51").Clear
-Range("B51").Clear
-Range("C51").Clear
-Range("D51").Clear
-Range("A51").Value = "xlDialogDefineStyle"
-Range("B51").Value = 229
-Range("C51").Value = num
-B51 = Range("B51").Value
-C51 = Range("C51").Value
-If B51 = C51 Then
-Range("D51").Value = "OK"
-Else
-Range("D51").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDeleteFormat(ByRef num)
-Range("A52").Clear
-Range("B52").Clear
-Range("C52").Clear
-Range("D52").Clear
-Range("A52").Value = "xlDialogDeleteFormat"
-Range("B52").Value = 111
-Range("C52").Value = num
-B52 = Range("B52").Value
-C52 = Range("C52").Value
-If B52 = C52 Then
-Range("D52").Value = "OK"
-Else
-Range("D52").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDeleteName(ByRef num)
-Range("A53").Clear
-Range("B53").Clear
-Range("C53").Clear
-Range("D53").Clear
-Range("A53").Value = "xlDialogDeleteName"
-Range("B53").Value = 110
-Range("C53").Value = num
-B53 = Range("B53").Value
-C53 = Range("C53").Value
-If B53 = C53 Then
-Range("D53").Value = "OK"
-Else
-Range("D53").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDemote(ByRef num)
-Range("A54").Clear
-Range("B54").Clear
-Range("C54").Clear
-Range("D54").Clear
-Range("A54").Value = "xlDialogDemote"
-Range("B54").Value = 203
-Range("C54").Value = num
-B54 = Range("B54").Value
-C54 = Range("C54").Value
-If B54 = C54 Then
-Range("D54").Value = "OK"
-Else
-Range("D54").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDisplay(ByRef num)
-Range("A55").Clear
-Range("B55").Clear
-Range("C55").Clear
-Range("D55").Clear
-Range("A55").Value = "xlDialogDisplay"
-Range("B55").Value = 27
-Range("C55").Value = num
-B55 = Range("B55").Value
-C55 = Range("C55").Value
-If B55 = C55 Then
-Range("D55").Value = "OK"
-Else
-Range("D55").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEditboxProperties(ByRef num)
-Range("A56").Clear
-Range("B56").Clear
-Range("C56").Clear
-Range("D56").Clear
-Range("A56").Value = "xlDialogEditboxProperties"
-Range("B56").Value = 438
-Range("C56").Value = num
-B56 = Range("B56").Value
-C56 = Range("C56").Value
-If B56 = C56 Then
-Range("D56").Value = "OK"
-Else
-Range("D56").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEditColor(ByRef num)
-Range("A57").Clear
-Range("B57").Clear
-Range("C57").Clear
-Range("D57").Clear
-Range("A57").Value = "xlDialogEditColor"
-Range("B57").Value = 223
-Range("C57").Value = num
-B57 = Range("B57").Value
-C57 = Range("C57").Value
-If B57 = C57 Then
-Range("D57").Value = "OK"
-Else
-Range("D57").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEditDelete(ByRef num)
-Range("A58").Clear
-Range("B58").Clear
-Range("C58").Clear
-Range("D58").Clear
-Range("A58").Value = "xlDialogEditDelete"
-Range("B58").Value = 54
-Range("C58").Value = num
-B58 = Range("B58").Value
-C58 = Range("C58").Value
-If B58 = C58 Then
-Range("D58").Value = "OK"
-Else
-Range("D58").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEditionOptions(ByRef num)
-Range("A59").Clear
-Range("B59").Clear
-Range("C59").Clear
-Range("D59").Clear
-Range("A59").Value = "xlDialogEditionOptions"
-Range("B59").Value = 251
-Range("C59").Value = num
-B59 = Range("B59").Value
-C59 = Range("C59").Value
-If B59 = C59 Then
-Range("D59").Value = "OK"
-Else
-Range("D59").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEditSeries(ByRef num)
-Range("A60").Clear
-Range("B60").Clear
-Range("C60").Clear
-Range("D60").Clear
-Range("A60").Value = "xlDialogEditSeries"
-Range("B60").Value = 228
-Range("C60").Value = num
-B60 = Range("B60").Value
-C60 = Range("C60").Value
-If B60 = C60 Then
-Range("D60").Value = "OK"
-Else
-Range("D60").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogErrorbarX(ByRef num)
-Range("A61").Clear
-Range("B61").Clear
-Range("C61").Clear
-Range("D61").Clear
-Range("A61").Value = "xlDialogErrorbarX"
-Range("B61").Value = 463
-Range("C61").Value = num
-B61 = Range("B61").Value
-C61 = Range("C61").Value
-If B61 = C61 Then
-Range("D61").Value = "OK"
-Else
-Range("D61").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogErrorbarY(ByRef num)
-Range("A62").Clear
-Range("B62").Clear
-Range("C62").Clear
-Range("D62").Clear
-Range("A62").Value = "xlDialogErrorbarY"
-Range("B62").Value = 464
-Range("C62").Value = num
-B62 = Range("B62").Value
-C62 = Range("C62").Value
-If B62 = C62 Then
-Range("D62").Value = "OK"
-Else
-Range("D62").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogErrorChecking(ByRef num)
-Range("A63").Clear
-Range("B63").Clear
-Range("C63").Clear
-Range("D63").Clear
-Range("A63").Value = "xlDialogErrorChecking"
-Range("B63").Value = 732
-Range("C63").Value = num
-B63 = Range("B63").Value
-C63 = Range("C63").Value
-If B63 = C63 Then
-Range("D63").Value = "OK"
-Else
-Range("D63").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEvaluateFormula(ByRef num)
-Range("A64").Clear
-Range("B64").Clear
-Range("C64").Clear
-Range("D64").Clear
-Range("A64").Value = "xlDialogEvaluateFormula"
-Range("B64").Value = 709
-Range("C64").Value = num
-B64 = Range("B64").Value
-C64 = Range("C64").Value
-If B64 = C64 Then
-Range("D64").Value = "OK"
-Else
-Range("D64").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogExternalDataProperties(ByRef num)
-Range("A65").Clear
-Range("B65").Clear
-Range("C65").Clear
-Range("D65").Clear
-Range("A65").Value = "xlDialogExternalDataProperties"
-Range("B65").Value = 530
-Range("C65").Value = num
-B65 = Range("B65").Value
-C65 = Range("C65").Value
-If B65 = C65 Then
-Range("D65").Value = "OK"
-Else
-Range("D65").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogExtract(ByRef num)
-Range("A66").Clear
-Range("B66").Clear
-Range("C66").Clear
-Range("D66").Clear
-Range("A66").Value = "xlDialogExtract"
-Range("B66").Value = 35
-Range("C66").Value = num
-B66 = Range("B66").Value
-C66 = Range("C66").Value
-If B66 = C66 Then
-Range("D66").Value = "OK"
-Else
-Range("D66").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFileDelete(ByRef num)
-Range("A67").Clear
-Range("B67").Clear
-Range("C67").Clear
-Range("D67").Clear
-Range("A67").Value = "xlDialogFileDelete"
-Range("B67").Value = 6
-Range("C67").Value = num
-B67 = Range("B67").Value
-C67 = Range("C67").Value
-If B67 = C67 Then
-Range("D67").Value = "OK"
-Else
-Range("D67").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFileSharing(ByRef num)
-Range("A68").Clear
-Range("B68").Clear
-Range("C68").Clear
-Range("D68").Clear
-Range("A68").Value = "xlDialogFileSharing"
-Range("B68").Value = 481
-Range("C68").Value = num
-B68 = Range("B68").Value
-C68 = Range("C68").Value
-If B68 = C68 Then
-Range("D68").Value = "OK"
-Else
-Range("D68").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFillGroup(ByRef num)
-Range("A69").Clear
-Range("B69").Clear
-Range("C69").Clear
-Range("D69").Clear
-Range("A69").Value = "xlDialogFillGroup"
-Range("B69").Value = 200
-Range("C69").Value = num
-B69 = Range("B69").Value
-C69 = Range("C69").Value
-If B69 = C69 Then
-Range("D69").Value = "OK"
-Else
-Range("D69").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFillWorkGroup(ByRef num)
-Range("A70").Clear
-Range("B70").Clear
-Range("C70").Clear
-Range("D70").Clear
-Range("A70").Value = "xlDialogFillWorkGroup"
-Range("B70").Value = 301
-Range("C70").Value = num
-B70 = Range("B70").Value
-C70 = Range("C70").Value
-If B70 = C70 Then
-Range("D70").Value = "OK"
-Else
-Range("D70").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFilter(ByRef num)
-Range("A71").Clear
-Range("B71").Clear
-Range("C71").Clear
-Range("D71").Clear
-Range("A71").Value = "xlDialogFilter"
-Range("B71").Value = 447
-Range("C71").Value = num
-B71 = Range("B71").Value
-C71 = Range("C71").Value
-If B71 = C71 Then
-Range("D71").Value = "OK"
-Else
-Range("D71").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFilterAdvanced(ByRef num)
-Range("A72").Clear
-Range("B72").Clear
-Range("C72").Clear
-Range("D72").Clear
-Range("A72").Value = "xlDialogFilterAdvanced"
-Range("B72").Value = 370
-Range("C72").Value = num
-B72 = Range("B72").Value
-C72 = Range("C72").Value
-If B72 = C72 Then
-Range("D72").Value = "OK"
-Else
-Range("D72").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFindFile(ByRef num)
-Range("A73").Clear
-Range("B73").Clear
-Range("C73").Clear
-Range("D73").Clear
-Range("A73").Value = "xlDialogFindFile"
-Range("B73").Value = 475
-Range("C73").Value = num
-B73 = Range("B73").Value
-C73 = Range("C73").Value
-If B73 = C73 Then
-Range("D73").Value = "OK"
-Else
-Range("D73").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFont(ByRef num)
-Range("A74").Clear
-Range("B74").Clear
-Range("C74").Clear
-Range("D74").Clear
-Range("A74").Value = "xlDialogFont"
-Range("B74").Value = 26
-Range("C74").Value = num
-B74 = Range("B74").Value
-C74 = Range("C74").Value
-If B74 = C74 Then
-Range("D74").Value = "OK"
-Else
-Range("D74").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFontProperties(ByRef num)
-Range("A75").Clear
-Range("B75").Clear
-Range("C75").Clear
-Range("D75").Clear
-Range("A75").Value = "xlDialogFontProperties"
-Range("B75").Value = 381
-Range("C75").Value = num
-B75 = Range("B75").Value
-C75 = Range("C75").Value
-If B75 = C75 Then
-Range("D75").Value = "OK"
-Else
-Range("D75").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatAuto(ByRef num)
-Range("A76").Clear
-Range("B76").Clear
-Range("C76").Clear
-Range("D76").Clear
-Range("A76").Value = "xlDialogFormatAuto"
-Range("B76").Value = 269
-Range("C76").Value = num
-B76 = Range("B76").Value
-C76 = Range("C76").Value
-If B76 = C76 Then
-Range("D76").Value = "OK"
-Else
-Range("D76").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatChart(ByRef num)
-Range("A77").Clear
-Range("B77").Clear
-Range("C77").Clear
-Range("D77").Clear
-Range("A77").Value = "xlDialogFormatChart"
-Range("B77").Value = 465
-Range("C77").Value = num
-B77 = Range("B77").Value
-C77 = Range("C77").Value
-If B77 = C77 Then
-Range("D77").Value = "OK"
-Else
-Range("D77").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatCharttype(ByRef num)
-Range("A78").Clear
-Range("B78").Clear
-Range("C78").Clear
-Range("D78").Clear
-Range("A78").Value = "xlDialogFormatCharttype"
-Range("B78").Value = 423
-Range("C78").Value = num
-B78 = Range("B78").Value
-C78 = Range("C78").Value
-If B78 = C78 Then
-Range("D78").Value = "OK"
-Else
-Range("D78").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatFont(ByRef num)
-Range("A79").Clear
-Range("B79").Clear
-Range("C79").Clear
-Range("D79").Clear
-Range("A79").Value = "xlDialogFormatFont"
-Range("B79").Value = 150
-Range("C79").Value = num
-B79 = Range("B79").Value
-C79 = Range("C79").Value
-If B79 = C79 Then
-Range("D79").Value = "OK"
-Else
-Range("D79").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatLegend(ByRef num)
-Range("A80").Clear
-Range("B80").Clear
-Range("C80").Clear
-Range("D80").Clear
-Range("A80").Value = "xlDialogFormatLegend"
-Range("B80").Value = 88
-Range("C80").Value = num
-B80 = Range("B80").Value
-C80 = Range("C80").Value
-If B80 = C80 Then
-Range("D80").Value = "OK"
-Else
-Range("D80").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatMain(ByRef num)
-Range("A81").Clear
-Range("B81").Clear
-Range("C81").Clear
-Range("D81").Clear
-Range("A81").Value = "xlDialogFormatMain"
-Range("B81").Value = 225
-Range("C81").Value = num
-B81 = Range("B81").Value
-C81 = Range("C81").Value
-If B81 = C81 Then
-Range("D81").Value = "OK"
-Else
-Range("D81").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatMove(ByRef num)
-Range("A82").Clear
-Range("B82").Clear
-Range("C82").Clear
-Range("D82").Clear
-Range("A82").Value = "xlDialogFormatMove"
-Range("B82").Value = 128
-Range("C82").Value = num
-B82 = Range("B82").Value
-C82 = Range("C82").Value
-If B82 = C82 Then
-Range("D82").Value = "OK"
-Else
-Range("D82").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatNumber(ByRef num)
-Range("A83").Clear
-Range("B83").Clear
-Range("C83").Clear
-Range("D83").Clear
-Range("A83").Value = "xlDialogFormatNumber"
-Range("B83").Value = 42
-Range("C83").Value = num
-B83 = Range("B83").Value
-C83 = Range("C83").Value
-If B83 = C83 Then
-Range("D83").Value = "OK"
-Else
-Range("D83").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatOverlay(ByRef num)
-Range("A84").Clear
-Range("B84").Clear
-Range("C84").Clear
-Range("D84").Clear
-Range("A84").Value = "xlDialogFormatOverlay"
-Range("B84").Value = 226
-Range("C84").Value = num
-B84 = Range("B84").Value
-C84 = Range("C84").Value
-If B84 = C84 Then
-Range("D84").Value = "OK"
-Else
-Range("D84").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatSize(ByRef num)
-Range("A85").Clear
-Range("B85").Clear
-Range("C85").Clear
-Range("D85").Clear
-Range("A85").Value = "xlDialogFormatSize"
-Range("B85").Value = 129
-Range("C85").Value = num
-B85 = Range("B85").Value
-C85 = Range("C85").Value
-If B85 = C85 Then
-Range("D85").Value = "OK"
-Else
-Range("D85").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatText(ByRef num)
-Range("A86").Clear
-Range("B86").Clear
-Range("C86").Clear
-Range("D86").Clear
-Range("A86").Value = "xlDialogFormatText"
-Range("B86").Value = 89
-Range("C86").Value = num
-B86 = Range("B86").Value
-C86 = Range("C86").Value
-If B86 = C86 Then
-Range("D86").Value = "OK"
-Else
-Range("D86").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormulaFind(ByRef num)
-Range("A87").Clear
-Range("B87").Clear
-Range("C87").Clear
-Range("D87").Clear
-Range("A87").Value = "xlDialogFormulaFind"
-Range("B87").Value = 64
-Range("C87").Value = num
-B87 = Range("B87").Value
-C87 = Range("C87").Value
-If B87 = C87 Then
-Range("D87").Value = "OK"
-Else
-Range("D87").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormulaGoto(ByRef num)
-Range("A88").Clear
-Range("B88").Clear
-Range("C88").Clear
-Range("D88").Clear
-Range("A88").Value = "xlDialogFormulaGoto"
-Range("B88").Value = 63
-Range("C88").Value = num
-B88 = Range("B88").Value
-C88 = Range("C88").Value
-If B88 = C88 Then
-Range("D88").Value = "OK"
-Else
-Range("D88").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormulaReplace(ByRef num)
-Range("A89").Clear
-Range("B89").Clear
-Range("C89").Clear
-Range("D89").Clear
-Range("A89").Value = "xlDialogFormulaReplace"
-Range("B89").Value = 130
-Range("C89").Value = num
-B89 = Range("B89").Value
-C89 = Range("C89").Value
-If B89 = C89 Then
-Range("D89").Value = "OK"
-Else
-Range("D89").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFunctionWizard(ByRef num)
-Range("A90").Clear
-Range("B90").Clear
-Range("C90").Clear
-Range("D90").Clear
-Range("A90").Value = "xlDialogFunctionWizard"
-Range("B90").Value = 450
-Range("C90").Value = num
-B90 = Range("B90").Value
-C90 = Range("C90").Value
-If B90 = C90 Then
-Range("D90").Value = "OK"
-Else
-Range("D90").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dArea(ByRef num)
-Range("A91").Clear
-Range("B91").Clear
-Range("C91").Clear
-Range("D91").Clear
-Range("A91").Value = "xlDialogGallery3dArea"
-Range("B91").Value = 193
-Range("C91").Value = num
-B91 = Range("B91").Value
-C91 = Range("C91").Value
-If B91 = C91 Then
-Range("D91").Value = "OK"
-Else
-Range("D91").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dBar(ByRef num)
-Range("A92").Clear
-Range("B92").Clear
-Range("C92").Clear
-Range("D92").Clear
-Range("A92").Value = "xlDialogGallery3dBar"
-Range("B92").Value = 272
-Range("C92").Value = num
-B92 = Range("B92").Value
-C92 = Range("C92").Value
-If B92 = C92 Then
-Range("D92").Value = "OK"
-Else
-Range("D92").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dColumn(ByRef num)
-Range("A93").Clear
-Range("B93").Clear
-Range("C93").Clear
-Range("D93").Clear
-Range("A93").Value = "xlDialogGallery3dColumn"
-Range("B93").Value = 194
-Range("C93").Value = num
-B93 = Range("B93").Value
-C93 = Range("C93").Value
-If B93 = C93 Then
-Range("D93").Value = "OK"
-Else
-Range("D93").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dLine(ByRef num)
-Range("A94").Clear
-Range("B94").Clear
-Range("C94").Clear
-Range("D94").Clear
-Range("A94").Value = "xlDialogGallery3dLine"
-Range("B94").Value = 195
-Range("C94").Value = num
-B94 = Range("B94").Value
-C94 = Range("C94").Value
-If B94 = C94 Then
-Range("D94").Value = "OK"
-Else
-Range("D94").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dPie(ByRef num)
-Range("A95").Clear
-Range("B95").Clear
-Range("C95").Clear
-Range("D95").Clear
-Range("A95").Value = "xlDialogGallery3dPie"
-Range("B95").Value = 196
-Range("C95").Value = num
-B95 = Range("B95").Value
-C95 = Range("C95").Value
-If B95 = C95 Then
-Range("D95").Value = "OK"
-Else
-Range("D95").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dSurface(ByRef num)
-Range("A96").Clear
-Range("B96").Clear
-Range("C96").Clear
-Range("D96").Clear
-Range("A96").Value = "xlDialogGallery3dSurface"
-Range("B96").Value = 273
-Range("C96").Value = num
-B96 = Range("B96").Value
-C96 = Range("C96").Value
-If B96 = C96 Then
-Range("D96").Value = "OK"
-Else
-Range("D96").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryArea(ByRef num)
-Range("A97").Clear
-Range("B97").Clear
-Range("C97").Clear
-Range("D97").Clear
-Range("A97").Value = "xlDialogGalleryArea"
-Range("B97").Value = 67
-Range("C97").Value = num
-B97 = Range("B97").Value
-C97 = Range("C97").Value
-If B97 = C97 Then
-Range("D97").Value = "OK"
-Else
-Range("D97").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryBar(ByRef num)
-Range("A98").Clear
-Range("B98").Clear
-Range("C98").Clear
-Range("D98").Clear
-Range("A98").Value = "xlDialogGalleryBar"
-Range("B98").Value = 68
-Range("C98").Value = num
-B98 = Range("B98").Value
-C98 = Range("C98").Value
-If B98 = C98 Then
-Range("D98").Value = "OK"
-Else
-Range("D98").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryColumn(ByRef num)
-Range("A99").Clear
-Range("B99").Clear
-Range("C99").Clear
-Range("D99").Clear
-Range("A99").Value = "xlDialogGalleryColumn"
-Range("B99").Value = 69
-Range("C99").Value = num
-B99 = Range("B99").Value
-C99 = Range("C99").Value
-If B99 = C99 Then
-Range("D99").Value = "OK"
-Else
-Range("D99").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryCustom(ByRef num)
-Range("A100").Clear
-Range("B100").Clear
-Range("C100").Clear
-Range("D100").Clear
-Range("A100").Value = "xlDialogGalleryCustom"
-Range("B100").Value = 388
-Range("C100").Value = num
-B100 = Range("B100").Value
-C100 = Range("C100").Value
-If B100 = C100 Then
-Range("D100").Value = "OK"
-Else
-Range("D100").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryDoughnut(ByRef num)
-Range("A101").Clear
-Range("B101").Clear
-Range("C101").Clear
-Range("D101").Clear
-Range("A101").Value = "xlDialogGalleryDoughnut"
-Range("B101").Value = 344
-Range("C101").Value = num
-B101 = Range("B101").Value
-C101 = Range("C101").Value
-If B101 = C101 Then
-Range("D101").Value = "OK"
-Else
-Range("D101").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryLine(ByRef num)
-Range("A102").Clear
-Range("B102").Clear
-Range("C102").Clear
-Range("D102").Clear
-Range("A102").Value = "xlDialogGalleryLine"
-Range("B102").Value = 70
-Range("C102").Value = num
-B102 = Range("B102").Value
-C102 = Range("C102").Value
-If B102 = C102 Then
-Range("D102").Value = "OK"
-Else
-Range("D102").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryPie(ByRef num)
-Range("A103").Clear
-Range("B103").Clear
-Range("C103").Clear
-Range("D103").Clear
-Range("A103").Value = "xlDialogGalleryPie"
-Range("B103").Value = 71
-Range("C103").Value = num
-B103 = Range("B103").Value
-C103 = Range("C103").Value
-If B103 = C103 Then
-Range("D103").Value = "OK"
-Else
-Range("D103").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryRader(ByRef num)
-Range("A104").Clear
-Range("B104").Clear
-Range("C104").Clear
-Range("D104").Clear
-Range("A104").Value = "xlDialogGalleryRader"
-Range("B104").Value = 249
-Range("C104").Value = num
-B104 = Range("B104").Value
-C104 = Range("C104").Value
-If B104 = C104 Then
-Range("D104").Value = "OK"
-Else
-Range("D104").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryScatter(ByRef num)
-Range("A105").Clear
-Range("B105").Clear
-Range("C105").Clear
-Range("D105").Clear
-Range("A105").Value = "xlDialogGalleryScatter"
-Range("B105").Value = 72
-Range("C105").Value = num
-B105 = Range("B105").Value
-C105 = Range("C105").Value
-If B105 = C105 Then
-Range("D105").Value = "OK"
-Else
-Range("D105").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGoalSeek(ByRef num)
-Range("A106").Clear
-Range("B106").Clear
-Range("C106").Clear
-Range("D106").Clear
-Range("A106").Value = "xlDialogGoalSeek"
-Range("B106").Value = 198
-Range("C106").Value = num
-B106 = Range("B106").Value
-C106 = Range("C106").Value
-If B106 = C106 Then
-Range("D106").Value = "OK"
-Else
-Range("D106").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGridlines(ByRef num)
-Range("A107").Clear
-Range("B107").Clear
-Range("C107").Clear
-Range("D107").Clear
-Range("A107").Value = "xlDialogGridlines"
-Range("B107").Value = 76
-Range("C107").Value = num
-B107 = Range("B107").Value
-C107 = Range("C107").Value
-If B107 = C107 Then
-Range("D107").Value = "OK"
-Else
-Range("D107").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogImportTextFile(ByRef num)
-Range("A108").Clear
-Range("B108").Clear
-Range("C108").Clear
-Range("D108").Clear
-Range("A108").Value = "xlDialogImportTextFile"
-Range("B108").Value = 666
-Range("C108").Value = num
-B108 = Range("B108").Value
-C108 = Range("C108").Value
-If B108 = C108 Then
-Range("D108").Value = "OK"
-Else
-Range("D108").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsert(ByRef num)
-Range("A109").Clear
-Range("B109").Clear
-Range("C109").Clear
-Range("D109").Clear
-Range("A109").Value = "xlDialogInsert"
-Range("B109").Value = 55
-Range("C109").Value = num
-B109 = Range("B109").Value
-C109 = Range("C109").Value
-If B109 = C109 Then
-Range("D109").Value = "OK"
-Else
-Range("D109").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsertHyperlink(ByRef num)
-Range("A110").Clear
-Range("B110").Clear
-Range("C110").Clear
-Range("D110").Clear
-Range("A110").Value = "xlDialogInsertHyperlink"
-Range("B110").Value = 596
-Range("C110").Value = num
-B110 = Range("B110").Value
-C110 = Range("C110").Value
-If B110 = C110 Then
-Range("D110").Value = "OK"
-Else
-Range("D110").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsertNameLabel(ByRef num)
-Range("A111").Clear
-Range("B111").Clear
-Range("C111").Clear
-Range("D111").Clear
-Range("A111").Value = "xlDialogInsertNameLabel"
-Range("B111").Value = 496
-Range("C111").Value = num
-B111 = Range("B111").Value
-C111 = Range("C111").Value
-If B111 = C111 Then
-Range("D111").Value = "OK"
-Else
-Range("D111").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsertObject(ByRef num)
-Range("A112").Clear
-Range("B112").Clear
-Range("C112").Clear
-Range("D112").Clear
-Range("A112").Value = "xlDialogInsertObject"
-Range("B112").Value = 259
-Range("C112").Value = num
-B112 = Range("B112").Value
-C112 = Range("C112").Value
-If B112 = C112 Then
-Range("D112").Value = "OK"
-Else
-Range("D112").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsertPicture(ByRef num)
-Range("A113").Clear
-Range("B113").Clear
-Range("C113").Clear
-Range("D113").Clear
-Range("A113").Value = "xlDialogInsertPicture"
-Range("B113").Value = 342
-Range("C113").Value = num
-B113 = Range("B113").Value
-C113 = Range("C113").Value
-If B113 = C113 Then
-Range("D113").Value = "OK"
-Else
-Range("D113").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsertTitle(ByRef num)
-Range("A114").Clear
-Range("B114").Clear
-Range("C114").Clear
-Range("D114").Clear
-Range("A114").Value = "xlDialogInsertTitle"
-Range("B114").Value = 380
-Range("C114").Value = num
-B114 = Range("B114").Value
-C114 = Range("C114").Value
-If B114 = C114 Then
-Range("D114").Value = "OK"
-Else
-Range("D114").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogLabelProperties(ByRef num)
-Range("A115").Clear
-Range("B115").Clear
-Range("C115").Clear
-Range("D115").Clear
-Range("A115").Value = "xlDialogLabelProperties"
-Range("B115").Value = 436
-Range("C115").Value = num
-B115 = Range("B115").Value
-C115 = Range("C115").Value
-If B115 = C115 Then
-Range("D115").Value = "OK"
-Else
-Range("D115").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogListboxProperties(ByRef num)
-Range("A116").Clear
-Range("B116").Clear
-Range("C116").Clear
-Range("D116").Clear
-Range("A116").Value = "xlDialogListboxProperties"
-Range("B116").Value = 437
-Range("C116").Value = num
-B116 = Range("B116").Value
-C116 = Range("C116").Value
-If B116 = C116 Then
-Range("D116").Value = "OK"
-Else
-Range("D116").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMacroOptions(ByRef num)
-Range("A117").Clear
-Range("B117").Clear
-Range("C117").Clear
-Range("D117").Clear
-Range("A117").Value = "xlDialogMacroOptions"
-Range("B117").Value = 382
-Range("C117").Value = num
-B117 = Range("B117").Value
-C117 = Range("C117").Value
-If B117 = C117 Then
-Range("D117").Value = "OK"
-Else
-Range("D117").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMailEditMailer(ByRef num)
-Range("A118").Clear
-Range("B118").Clear
-Range("C118").Clear
-Range("D118").Clear
-Range("A118").Value = "xlDialogMailEditMailer"
-Range("B118").Value = 470
-Range("C118").Value = num
-B118 = Range("B118").Value
-C118 = Range("C118").Value
-If B118 = C118 Then
-Range("D118").Value = "OK"
-Else
-Range("D118").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMailLogon(ByRef num)
-Range("A119").Clear
-Range("B119").Clear
-Range("C119").Clear
-Range("D119").Clear
-Range("A119").Value = "xlDialogMailLogon"
-Range("B119").Value = 339
-Range("C119").Value = num
-B119 = Range("B119").Value
-C119 = Range("C119").Value
-If B119 = C119 Then
-Range("D119").Value = "OK"
-Else
-Range("D119").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMailNextLetter(ByRef num)
-Range("A120").Clear
-Range("B120").Clear
-Range("C120").Clear
-Range("D120").Clear
-Range("A120").Value = "xlDialogMailNextLetter"
-Range("B120").Value = 378
-Range("C120").Value = num
-B120 = Range("B120").Value
-C120 = Range("C120").Value
-If B120 = C120 Then
-Range("D120").Value = "OK"
-Else
-Range("D120").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMainChart(ByRef num)
-Range("A121").Clear
-Range("B121").Clear
-Range("C121").Clear
-Range("D121").Clear
-Range("A121").Value = "xlDialogMainChart"
-Range("B121").Value = 85
-Range("C121").Value = num
-B121 = Range("B121").Value
-C121 = Range("C121").Value
-If B121 = C121 Then
-Range("D121").Value = "OK"
-Else
-Range("D121").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMainChartType(ByRef num)
-Range("A122").Clear
-Range("B122").Clear
-Range("C122").Clear
-Range("D122").Clear
-Range("A122").Value = "xlDialogMainChartType"
-Range("B122").Value = 185
-Range("C122").Value = num
-B122 = Range("B122").Value
-C122 = Range("C122").Value
-If B122 = C122 Then
-Range("D122").Value = "OK"
-Else
-Range("D122").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMenuEditor(ByRef num)
-Range("A123").Clear
-Range("B123").Clear
-Range("C123").Clear
-Range("D123").Clear
-Range("A123").Value = "xlDialogMenuEditor"
-Range("B123").Value = 322
-Range("C123").Value = num
-B123 = Range("B123").Value
-C123 = Range("C123").Value
-If B123 = C123 Then
-Range("D123").Value = "OK"
-Else
-Range("D123").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMove(ByRef num)
-Range("A124").Clear
-Range("B124").Clear
-Range("C124").Clear
-Range("D124").Clear
-Range("A124").Value = "xlDialogMove"
-Range("B124").Value = 262
-Range("C124").Value = num
-B124 = Range("B124").Value
-C124 = Range("C124").Value
-If B124 = C124 Then
-Range("D124").Value = "OK"
-Else
-Range("D124").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMyPermission(ByRef num)
-Range("A125").Clear
-Range("B125").Clear
-Range("C125").Clear
-Range("D125").Clear
-Range("A125").Value = "xlDialogMyPermission"
-Range("B125").Value = 834
-Range("C125").Value = num
-B125 = Range("B125").Value
-C125 = Range("C125").Value
-If B125 = C125 Then
-Range("D125").Value = "OK"
-Else
-Range("D125").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogNew(ByRef num)
-Range("A126").Clear
-Range("B126").Clear
-Range("C126").Clear
-Range("D126").Clear
-Range("A126").Value = "xlDialogNew"
-Range("B126").Value = 119
-Range("C126").Value = num
-B126 = Range("B126").Value
-C126 = Range("C126").Value
-If B126 = C126 Then
-Range("D126").Value = "OK"
-Else
-Range("D126").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogNewWebQuery(ByRef num)
-Range("A127").Clear
-Range("B127").Clear
-Range("C127").Clear
-Range("D127").Clear
-Range("A127").Value = "xlDialogNewWebQuery"
-Range("B127").Value = 667
-Range("C127").Value = num
-B127 = Range("B127").Value
-C127 = Range("C127").Value
-If B127 = C127 Then
-Range("D127").Value = "OK"
-Else
-Range("D127").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogNote(ByRef num)
-Range("A128").Clear
-Range("B128").Clear
-Range("C128").Clear
-Range("D128").Clear
-Range("A128").Value = "xlDialogNote"
-Range("B128").Value = 154
-Range("C128").Value = num
-B128 = Range("B128").Value
-C128 = Range("C128").Value
-If B128 = C128 Then
-Range("D128").Value = "OK"
-Else
-Range("D128").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogObjectProperties(ByRef num)
-Range("A129").Clear
-Range("B129").Clear
-Range("C129").Clear
-Range("D129").Clear
-Range("A129").Value = "xlDialogObjectProperties"
-Range("B129").Value = 207
-Range("C129").Value = num
-B129 = Range("B129").Value
-C129 = Range("C129").Value
-If B129 = C129 Then
-Range("D129").Value = "OK"
-Else
-Range("D129").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogObjectProtection(ByRef num)
-Range("A130").Clear
-Range("B130").Clear
-Range("C130").Clear
-Range("D130").Clear
-Range("A130").Value = "xlDialogObjectProtection"
-Range("B130").Value = 214
-Range("C130").Value = num
-B130 = Range("B130").Value
-C130 = Range("C130").Value
-If B130 = C130 Then
-Range("D130").Value = "OK"
-Else
-Range("D130").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOpen(ByRef num)
-Range("A131").Clear
-Range("B131").Clear
-Range("C131").Clear
-Range("D131").Clear
-Range("A131").Value = "xlDialogOpen"
-Range("B131").Value = 1
-Range("C131").Value = num
-B131 = Range("B131").Value
-C131 = Range("C131").Value
-If B131 = C131 Then
-Range("D131").Value = "OK"
-Else
-Range("D131").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOpenLinks(ByRef num)
-Range("A132").Clear
-Range("B132").Clear
-Range("C132").Clear
-Range("D132").Clear
-Range("A132").Value = "xlDialogOpenLinks"
-Range("B132").Value = 2
-Range("C132").Value = num
-B132 = Range("B132").Value
-C132 = Range("C132").Value
-If B132 = C132 Then
-Range("D132").Value = "OK"
-Else
-Range("D132").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOpenMail(ByRef num)
-Range("A133").Clear
-Range("B133").Clear
-Range("C133").Clear
-Range("D133").Clear
-Range("A133").Value = "xlDialogOpenMail"
-Range("B133").Value = 188
-Range("C133").Value = num
-B133 = Range("B133").Value
-C133 = Range("C133").Value
-If B133 = C133 Then
-Range("D133").Value = "OK"
-Else
-Range("D133").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOpenText(ByRef num)
-Range("A134").Clear
-Range("B134").Clear
-Range("C134").Clear
-Range("D134").Clear
-Range("A134").Value = "xlDialogOpenText"
-Range("B134").Value = 441
-Range("C134").Value = num
-B134 = Range("B134").Value
-C134 = Range("C134").Value
-If B134 = C134 Then
-Range("D134").Value = "OK"
-Else
-Range("D134").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsCalculation(ByRef num)
-Range("A135").Clear
-Range("B135").Clear
-Range("C135").Clear
-Range("D135").Clear
-Range("A135").Value = "xlDialogOptionsCalculation"
-Range("B135").Value = 318
-Range("C135").Value = num
-B135 = Range("B135").Value
-C135 = Range("C135").Value
-If B135 = C135 Then
-Range("D135").Value = "OK"
-Else
-Range("D135").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsChart(ByRef num)
-Range("A136").Clear
-Range("B136").Clear
-Range("C136").Clear
-Range("D136").Clear
-Range("A136").Value = "xlDialogOptionsChart"
-Range("B136").Value = 325
-Range("C136").Value = num
-B136 = Range("B136").Value
-C136 = Range("C136").Value
-If B136 = C136 Then
-Range("D136").Value = "OK"
-Else
-Range("D136").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsEdit(ByRef num)
-Range("A137").Clear
-Range("B137").Clear
-Range("C137").Clear
-Range("D137").Clear
-Range("A137").Value = "xlDialogOptionsEdit"
-Range("B137").Value = 319
-Range("C137").Value = num
-B137 = Range("B137").Value
-C137 = Range("C137").Value
-If B137 = C137 Then
-Range("D137").Value = "OK"
-Else
-Range("D137").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsGeneral(ByRef num)
-Range("A138").Clear
-Range("B138").Clear
-Range("C138").Clear
-Range("D138").Clear
-Range("A138").Value = "xlDialogOptionsGeneral"
-Range("B138").Value = 356
-Range("C138").Value = num
-B138 = Range("B138").Value
-C138 = Range("C138").Value
-If B138 = C138 Then
-Range("D138").Value = "OK"
-Else
-Range("D138").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsListAdd(ByRef num)
-Range("A139").Clear
-Range("B139").Clear
-Range("C139").Clear
-Range("D139").Clear
-Range("A139").Value = "xlDialogOptionsListAdd"
-Range("B139").Value = 458
-Range("C139").Value = num
-B139 = Range("B139").Value
-C139 = Range("C139").Value
-If B139 = C139 Then
-Range("D139").Value = "OK"
-Else
-Range("D139").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsME(ByRef num)
-Range("A140").Clear
-Range("B140").Clear
-Range("C140").Clear
-Range("D140").Clear
-Range("A140").Value = "xlDialogOptionsME"
-Range("B140").Value = 647
-Range("C140").Value = num
-B140 = Range("B140").Value
-C140 = Range("C140").Value
-If B140 = C140 Then
-Range("D140").Value = "OK"
-Else
-Range("D140").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsTransition(ByRef num)
-Range("A141").Clear
-Range("B141").Clear
-Range("C141").Clear
-Range("D141").Clear
-Range("A141").Value = "xlDialogOptionsTransition"
-Range("B141").Value = 355
-Range("C141").Value = num
-B141 = Range("B141").Value
-C141 = Range("C141").Value
-If B141 = C141 Then
-Range("D141").Value = "OK"
-Else
-Range("D141").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsView(ByRef num)
-Range("A142").Clear
-Range("B142").Clear
-Range("C142").Clear
-Range("D142").Clear
-Range("A142").Value = "xlDialogOptionsView"
-Range("B142").Value = 320
-Range("C142").Value = num
-B142 = Range("B142").Value
-C142 = Range("C142").Value
-If B142 = C142 Then
-Range("D142").Value = "OK"
-Else
-Range("D142").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOutline(ByRef num)
-Range("A143").Clear
-Range("B143").Clear
-Range("C143").Clear
-Range("D143").Clear
-Range("A143").Value = "xlDialogOutline"
-Range("B143").Value = 142
-Range("C143").Value = num
-B143 = Range("B143").Value
-C143 = Range("C143").Value
-If B143 = C143 Then
-Range("D143").Value = "OK"
-Else
-Range("D143").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOverlay(ByRef num)
-Range("A144").Clear
-Range("B144").Clear
-Range("C144").Clear
-Range("D144").Clear
-Range("A144").Value = "xlDialogOverlay"
-Range("B144").Value = 86
-Range("C144").Value = num
-B144 = Range("B144").Value
-C144 = Range("C144").Value
-If B144 = C144 Then
-Range("D144").Value = "OK"
-Else
-Range("D144").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOverlayChartType(ByRef num)
-Range("A145").Clear
-Range("B145").Clear
-Range("C145").Clear
-Range("D145").Clear
-Range("A145").Value = "xlDialogOverlayChartType"
-Range("B145").Value = 186
-Range("C145").Value = num
-B145 = Range("B145").Value
-C145 = Range("C145").Value
-If B145 = C145 Then
-Range("D145").Value = "OK"
-Else
-Range("D145").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPageSetup(ByRef num)
-Range("A146").Clear
-Range("B146").Clear
-Range("C146").Clear
-Range("D146").Clear
-Range("A146").Value = "xlDialogPageSetup"
-Range("B146").Value = 7
-Range("C146").Value = num
-B146 = Range("B146").Value
-C146 = Range("C146").Value
-If B146 = C146 Then
-Range("D146").Value = "OK"
-Else
-Range("D146").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogParse(ByRef num)
-Range("A147").Clear
-Range("B147").Clear
-Range("C147").Clear
-Range("D147").Clear
-Range("A147").Value = "xlDialogParse"
-Range("B147").Value = 91
-Range("C147").Value = num
-B147 = Range("B147").Value
-C147 = Range("C147").Value
-If B147 = C147 Then
-Range("D147").Value = "OK"
-Else
-Range("D147").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPasteNames(ByRef num)
-Range("A148").Clear
-Range("B148").Clear
-Range("C148").Clear
-Range("D148").Clear
-Range("A148").Value = "xlDialogPasteNames"
-Range("B148").Value = 58
-Range("C148").Value = num
-B148 = Range("B148").Value
-C148 = Range("C148").Value
-If B148 = C148 Then
-Range("D148").Value = "OK"
-Else
-Range("D148").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPasteSpecial(ByRef num)
-Range("A149").Clear
-Range("B149").Clear
-Range("C149").Clear
-Range("D149").Clear
-Range("A149").Value = "xlDialogPasteSpecial"
-Range("B149").Value = 53
-Range("C149").Value = num
-B149 = Range("B149").Value
-C149 = Range("C149").Value
-If B149 = C149 Then
-Range("D149").Value = "OK"
-Else
-Range("D149").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPatterns(ByRef num)
-Range("A150").Clear
-Range("B150").Clear
-Range("C150").Clear
-Range("D150").Clear
-Range("A150").Value = "xlDialogPatterns"
-Range("B150").Value = 84
-Range("C150").Value = num
-B150 = Range("B150").Value
-C150 = Range("C150").Value
-If B150 = C150 Then
-Range("D150").Value = "OK"
-Else
-Range("D150").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPermission(ByRef num)
-Range("A151").Clear
-Range("B151").Clear
-Range("C151").Clear
-Range("D151").Clear
-Range("A151").Value = "xlDialogPermission"
-Range("B151").Value = 832
-Range("C151").Value = num
-B151 = Range("B151").Value
-C151 = Range("C151").Value
-If B151 = C151 Then
-Range("D151").Value = "OK"
-Else
-Range("D151").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPhonetic(ByRef num)
-Range("A152").Clear
-Range("B152").Clear
-Range("C152").Clear
-Range("D152").Clear
-Range("A152").Value = "xlDialogPhonetic"
-Range("B152").Value = 656
-Range("C152").Value = num
-B152 = Range("B152").Value
-C152 = Range("C152").Value
-If B152 = C152 Then
-Range("D152").Value = "OK"
-Else
-Range("D152").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotCalculatedField(ByRef num)
-Range("A153").Clear
-Range("B153").Clear
-Range("C153").Clear
-Range("D153").Clear
-Range("A153").Value = "xlDialogPivotCalculatedField"
-Range("B153").Value = 570
-Range("C153").Value = num
-B153 = Range("B153").Value
-C153 = Range("C153").Value
-If B153 = C153 Then
-Range("D153").Value = "OK"
-Else
-Range("D153").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotCalculatedItem(ByRef num)
-Range("A154").Clear
-Range("B154").Clear
-Range("C154").Clear
-Range("D154").Clear
-Range("A154").Value = "xlDialogPivotCalculatedItem"
-Range("B154").Value = 572
-Range("C154").Value = num
-B154 = Range("B154").Value
-C154 = Range("C154").Value
-If B154 = C154 Then
-Range("D154").Value = "OK"
-Else
-Range("D154").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotClientServerSet(ByRef num)
-Range("A155").Clear
-Range("B155").Clear
-Range("C155").Clear
-Range("D155").Clear
-Range("A155").Value = "xlDialogPivotClientServerSet"
-Range("B155").Value = 689
-Range("C155").Value = num
-B155 = Range("B155").Value
-C155 = Range("C155").Value
-If B155 = C155 Then
-Range("D155").Value = "OK"
-Else
-Range("D155").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotFieldGroup(ByRef num)
-Range("A156").Clear
-Range("B156").Clear
-Range("C156").Clear
-Range("D156").Clear
-Range("A156").Value = "xlDialogPivotFieldGroup"
-Range("B156").Value = 433
-Range("C156").Value = num
-B156 = Range("B156").Value
-C156 = Range("C156").Value
-If B156 = C156 Then
-Range("D156").Value = "OK"
-Else
-Range("D156").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotFieldProperties(ByRef num)
-Range("A157").Clear
-Range("B157").Clear
-Range("C157").Clear
-Range("D157").Clear
-Range("A157").Value = "xlDialogPivotFieldProperties"
-Range("B157").Value = 313
-Range("C157").Value = num
-B157 = Range("B157").Value
-C157 = Range("C157").Value
-If B157 = C157 Then
-Range("D157").Value = "OK"
-Else
-Range("D157").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotFieldUngroup(ByRef num)
-Range("A158").Clear
-Range("B158").Clear
-Range("C158").Clear
-Range("D158").Clear
-Range("A158").Value = "xlDialogPivotFieldUngroup"
-Range("B158").Value = 434
-Range("C158").Value = num
-B158 = Range("B158").Value
-C158 = Range("C158").Value
-If B158 = C158 Then
-Range("D158").Value = "OK"
-Else
-Range("D158").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotShowPages(ByRef num)
-Range("A159").Clear
-Range("B159").Clear
-Range("C159").Clear
-Range("D159").Clear
-Range("A159").Value = "xlDialogPivotShowPages"
-Range("B159").Value = 421
-Range("C159").Value = num
-B159 = Range("B159").Value
-C159 = Range("C159").Value
-If B159 = C159 Then
-Range("D159").Value = "OK"
-Else
-Range("D159").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotSolveOrder(ByRef num)
-Range("A160").Clear
-Range("B160").Clear
-Range("C160").Clear
-Range("D160").Clear
-Range("A160").Value = "xlDialogPivotSolveOrder"
-Range("B160").Value = 568
-Range("C160").Value = num
-B160 = Range("B160").Value
-C160 = Range("C160").Value
-If B160 = C160 Then
-Range("D160").Value = "OK"
-Else
-Range("D160").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotTableOptions(ByRef num)
-Range("A161").Clear
-Range("B161").Clear
-Range("C161").Clear
-Range("D161").Clear
-Range("A161").Value = "xlDialogPivotTableOptions"
-Range("B161").Value = 567
-Range("C161").Value = num
-B161 = Range("B161").Value
-C161 = Range("C161").Value
-If B161 = C161 Then
-Range("D161").Value = "OK"
-Else
-Range("D161").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotTableWizard(ByRef num)
-Range("A162").Clear
-Range("B162").Clear
-Range("C162").Clear
-Range("D162").Clear
-Range("A162").Value = "xlDialogPivotTableWizard"
-Range("B162").Value = 321
-Range("C162").Value = num
-B162 = Range("B162").Value
-C162 = Range("C162").Value
-If B162 = C162 Then
-Range("D162").Value = "OK"
-Else
-Range("D162").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPlacement(ByRef num)
-Range("A163").Clear
-Range("B163").Clear
-Range("C163").Clear
-Range("D163").Clear
-Range("A163").Value = "xlDialogPlacement"
-Range("B163").Value = 300
-Range("C163").Value = num
-B163 = Range("B163").Value
-C163 = Range("C163").Value
-If B163 = C163 Then
-Range("D163").Value = "OK"
-Else
-Range("D163").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPrint(ByRef num)
-Range("A164").Clear
-Range("B164").Clear
-Range("C164").Clear
-Range("D164").Clear
-Range("A164").Value = "xlDialogPrint"
-Range("B164").Value = 8
-Range("C164").Value = num
-B164 = Range("B164").Value
-C164 = Range("C164").Value
-If B164 = C164 Then
-Range("D164").Value = "OK"
-Else
-Range("D164").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPrintSetup(ByRef num)
-Range("A165").Clear
-Range("B165").Clear
-Range("C165").Clear
-Range("D165").Clear
-Range("A165").Value = "xlDialogPrintSetup"
-Range("B165").Value = 9
-Range("C165").Value = num
-B165 = Range("B165").Value
-C165 = Range("C165").Value
-If B165 = C165 Then
-Range("D165").Value = "OK"
-Else
-Range("D165").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPrintPreview(ByRef num)
-Range("A166").Clear
-Range("B166").Clear
-Range("C166").Clear
-Range("D166").Clear
-Range("A166").Value = "xlDialogPrintPreview"
-Range("B166").Value = 222
-Range("C166").Value = num
-B166 = Range("B166").Value
-C166 = Range("C166").Value
-If B166 = C166 Then
-Range("D166").Value = "OK"
-Else
-Range("D166").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPromote(ByRef num)
-Range("A167").Clear
-Range("B167").Clear
-Range("C167").Clear
-Range("D167").Clear
-Range("A167").Value = "xlDialogPromote"
-Range("B167").Value = 202
-Range("C167").Value = num
-B167 = Range("B167").Value
-C167 = Range("C167").Value
-If B167 = C167 Then
-Range("D167").Value = "OK"
-Else
-Range("D167").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogProperties(ByRef num)
-Range("A168").Clear
-Range("B168").Clear
-Range("C168").Clear
-Range("D168").Clear
-Range("A168").Value = "xlDialogProperties"
-Range("B168").Value = 474
-Range("C168").Value = num
-B168 = Range("B168").Value
-C168 = Range("C168").Value
-If B168 = C168 Then
-Range("D168").Value = "OK"
-Else
-Range("D168").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPropertyFields(ByRef num)
-Range("A169").Clear
-Range("B169").Clear
-Range("C169").Clear
-Range("D169").Clear
-Range("A169").Value = "xlDialogPropertyFields"
-Range("B169").Value = 754
-Range("C169").Value = num
-B169 = Range("B169").Value
-C169 = Range("C169").Value
-If B169 = C169 Then
-Range("D169").Value = "OK"
-Else
-Range("D169").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogProtectDocument(ByRef num)
-Range("A170").Clear
-Range("B170").Clear
-Range("C170").Clear
-Range("D170").Clear
-Range("A170").Value = "xlDialogProtectDocument"
-Range("B170").Value = 28
-Range("C170").Value = num
-B170 = Range("B170").Value
-C170 = Range("C170").Value
-If B170 = C170 Then
-Range("D170").Value = "OK"
-Else
-Range("D170").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogProtectSharing(ByRef num)
-Range("A171").Clear
-Range("B171").Clear
-Range("C171").Clear
-Range("D171").Clear
-Range("A171").Value = "xlDialogProtectSharing"
-Range("B171").Value = 620
-Range("C171").Value = num
-B171 = Range("B171").Value
-C171 = Range("C171").Value
-If B171 = C171 Then
-Range("D171").Value = "OK"
-Else
-Range("D171").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPublishAsWebPage(ByRef num)
-Range("A172").Clear
-Range("B172").Clear
-Range("C172").Clear
-Range("D172").Clear
-Range("A172").Value = "xlDialogPublishAsWebPage"
-Range("B172").Value = 653
-Range("C172").Value = num
-B172 = Range("B172").Value
-C172 = Range("C172").Value
-If B172 = C172 Then
-Range("D172").Value = "OK"
-Else
-Range("D172").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPushbuttonProperties(ByRef num)
-Range("A173").Clear
-Range("B173").Clear
-Range("C173").Clear
-Range("D173").Clear
-Range("A173").Value = "xlDialogPushbuttonProperties"
-Range("B173").Value = 445
-Range("C173").Value = num
-B173 = Range("B173").Value
-C173 = Range("C173").Value
-If B173 = C173 Then
-Range("D173").Value = "OK"
-Else
-Range("D173").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogReplaceFont(ByRef num)
-Range("A174").Clear
-Range("B174").Clear
-Range("C174").Clear
-Range("D174").Clear
-Range("A174").Value = "xlDialogReplaceFont"
-Range("B174").Value = 134
-Range("C174").Value = num
-B174 = Range("B174").Value
-C174 = Range("C174").Value
-If B174 = C174 Then
-Range("D174").Value = "OK"
-Else
-Range("D174").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogRoutingSlip(ByRef num)
-Range("A175").Clear
-Range("B175").Clear
-Range("C175").Clear
-Range("D175").Clear
-Range("A175").Value = "xlDialogRoutingSlip"
-Range("B175").Value = 336
-Range("C175").Value = num
-B175 = Range("B175").Value
-C175 = Range("C175").Value
-If B175 = C175 Then
-Range("D175").Value = "OK"
-Else
-Range("D175").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogRowHeight(ByRef num)
-Range("A176").Clear
-Range("B176").Clear
-Range("C176").Clear
-Range("D176").Clear
-Range("A176").Value = "xlDialogRowHeight"
-Range("B176").Value = 127
-Range("C176").Value = num
-B176 = Range("B176").Value
-C176 = Range("C176").Value
-If B176 = C176 Then
-Range("D176").Value = "OK"
-Else
-Range("D176").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogRun(ByRef num)
-Range("A177").Clear
-Range("B177").Clear
-Range("C177").Clear
-Range("D177").Clear
-Range("A177").Value = "xlDialogRun"
-Range("B177").Value = 17
-Range("C177").Value = num
-B177 = Range("B177").Value
-C177 = Range("C177").Value
-If B177 = C177 Then
-Range("D177").Value = "OK"
-Else
-Range("D177").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSaveAs(ByRef num)
-Range("A178").Clear
-Range("B178").Clear
-Range("C178").Clear
-Range("D178").Clear
-Range("A178").Value = "xlDialogSaveAs"
-Range("B178").Value = 5
-Range("C178").Value = num
-B178 = Range("B178").Value
-C178 = Range("C178").Value
-If B178 = C178 Then
-Range("D178").Value = "OK"
-Else
-Range("D178").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSaveCopyAs(ByRef num)
-Range("A179").Clear
-Range("B179").Clear
-Range("C179").Clear
-Range("D179").Clear
-Range("A179").Value = "xlDialogSaveCopyAs"
-Range("B179").Value = 456
-Range("C179").Value = num
-B179 = Range("B179").Value
-C179 = Range("C179").Value
-If B179 = C179 Then
-Range("D179").Value = "OK"
-Else
-Range("D179").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSaveNewObject(ByRef num)
-Range("A180").Clear
-Range("B180").Clear
-Range("C180").Clear
-Range("D180").Clear
-Range("A180").Value = "xlDialogSaveNewObject"
-Range("B180").Value = 208
-Range("C180").Value = num
-B180 = Range("B180").Value
-C180 = Range("C180").Value
-If B180 = C180 Then
-Range("D180").Value = "OK"
-Else
-Range("D180").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSaveWorkbook(ByRef num)
-Range("A181").Clear
-Range("B181").Clear
-Range("C181").Clear
-Range("D181").Clear
-Range("A181").Value = "xlDialogSaveWorkbook"
-Range("B181").Value = 145
-Range("C181").Value = num
-B181 = Range("B181").Value
-C181 = Range("C181").Value
-If B181 = C181 Then
-Range("D181").Value = "OK"
-Else
-Range("D181").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSaveWorkspace(ByRef num)
-Range("A182").Clear
-Range("B182").Clear
-Range("C182").Clear
-Range("D182").Clear
-Range("A182").Value = "xlDialogSaveWorkspace"
-Range("B182").Value = 285
-Range("C182").Value = num
-B182 = Range("B182").Value
-C182 = Range("C182").Value
-If B182 = C182 Then
-Range("D182").Value = "OK"
-Else
-Range("D182").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScale(ByRef num)
-Range("A183").Clear
-Range("B183").Clear
-Range("C183").Clear
-Range("D183").Clear
-Range("A183").Value = "xlDialogScale"
-Range("B183").Value = 87
-Range("C183").Value = num
-B183 = Range("B183").Value
-C183 = Range("C183").Value
-If B183 = C183 Then
-Range("D183").Value = "OK"
-Else
-Range("D183").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScenarioAdd(ByRef num)
-Range("A184").Clear
-Range("B184").Clear
-Range("C184").Clear
-Range("D184").Clear
-Range("A184").Value = "xlDialogScenarioAdd"
-Range("B184").Value = 307
-Range("C184").Value = num
-B184 = Range("B184").Value
-C184 = Range("C184").Value
-If B184 = C184 Then
-Range("D184").Value = "OK"
-Else
-Range("D184").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScenarioCells(ByRef num)
-Range("A185").Clear
-Range("B185").Clear
-Range("C185").Clear
-Range("D185").Clear
-Range("A185").Value = "xlDialogScenarioCells"
-Range("B185").Value = 305
-Range("C185").Value = num
-B185 = Range("B185").Value
-C185 = Range("C185").Value
-If B185 = C185 Then
-Range("D185").Value = "OK"
-Else
-Range("D185").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScenarioEdit(ByRef num)
-Range("A186").Clear
-Range("B186").Clear
-Range("C186").Clear
-Range("D186").Clear
-Range("A186").Value = "xlDialogScenarioEdit"
-Range("B186").Value = 308
-Range("C186").Value = num
-B186 = Range("B186").Value
-C186 = Range("C186").Value
-If B186 = C186 Then
-Range("D186").Value = "OK"
-Else
-Range("D186").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScenarioMerge(ByRef num)
-Range("A187").Clear
-Range("B187").Clear
-Range("C187").Clear
-Range("D187").Clear
-Range("A187").Value = "xlDialogScenarioMerge"
-Range("B187").Value = 473
-Range("C187").Value = num
-B187 = Range("B187").Value
-C187 = Range("C187").Value
-If B187 = C187 Then
-Range("D187").Value = "OK"
-Else
-Range("D187").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScenarioSummary(ByRef num)
-Range("A188").Clear
-Range("B188").Clear
-Range("C188").Clear
-Range("D188").Clear
-Range("A188").Value = "xlDialogScenarioSummary"
-Range("B188").Value = 311
-Range("C188").Value = num
-B188 = Range("B188").Value
-C188 = Range("C188").Value
-If B188 = C188 Then
-Range("D188").Value = "OK"
-Else
-Range("D188").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScrollbarProperties(ByRef num)
-Range("A189").Clear
-Range("B189").Clear
-Range("C189").Clear
-Range("D189").Clear
-Range("A189").Value = "xlDialogScrollbarProperties"
-Range("B189").Value = 420
-Range("C189").Value = num
-B189 = Range("B189").Value
-C189 = Range("C189").Value
-If B189 = C189 Then
-Range("D189").Value = "OK"
-Else
-Range("D189").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSearch(ByRef num)
-Range("A190").Clear
-Range("B190").Clear
-Range("C190").Clear
-Range("D190").Clear
-Range("A190").Value = "xlDialogSearch"
-Range("B190").Value = 731
-Range("C190").Value = num
-B190 = Range("B190").Value
-C190 = Range("C190").Value
-If B190 = C190 Then
-Range("D190").Value = "OK"
-Else
-Range("D190").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSelectSpecial(ByRef num)
-Range("A191").Clear
-Range("B191").Clear
-Range("C191").Clear
-Range("D191").Clear
-Range("A191").Value = "xlDialogSelectSpecial"
-Range("B191").Value = 132
-Range("C191").Value = num
-B191 = Range("B191").Value
-C191 = Range("C191").Value
-If B191 = C191 Then
-Range("D191").Value = "OK"
-Else
-Range("D191").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSendMail(ByRef num)
-Range("A192").Clear
-Range("B192").Clear
-Range("C192").Clear
-Range("D192").Clear
-Range("A192").Value = "xlDialogSendMail"
-Range("B192").Value = 189
-Range("C192").Value = num
-B192 = Range("B192").Value
-C192 = Range("C192").Value
-If B192 = C192 Then
-Range("D192").Value = "OK"
-Else
-Range("D192").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesAxes(ByRef num)
-Range("A193").Clear
-Range("B193").Clear
-Range("C193").Clear
-Range("D193").Clear
-Range("A193").Value = "xlDialogSeriesAxes"
-Range("B193").Value = 450
-Range("C193").Value = num
-B193 = Range("B193").Value
-C193 = Range("C193").Value
-If B193 = C193 Then
-Range("D193").Value = "OK"
-Else
-Range("D193").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesOptions(ByRef num)
-Range("A194").Clear
-Range("B194").Clear
-Range("C194").Clear
-Range("D194").Clear
-Range("A194").Value = "xlDialogSeriesOptions"
-Range("B194").Value = 557
-Range("C194").Value = num
-B194 = Range("B194").Value
-C194 = Range("C194").Value
-If B194 = C194 Then
-Range("D194").Value = "OK"
-Else
-Range("D194").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesOrder(ByRef num)
-Range("A195").Clear
-Range("B195").Clear
-Range("C195").Clear
-Range("D195").Clear
-Range("A195").Value = "xlDialogSeriesOrder"
-Range("B195").Value = 466
-Range("C195").Value = num
-B195 = Range("B195").Value
-C195 = Range("C195").Value
-If B195 = C195 Then
-Range("D195").Value = "OK"
-Else
-Range("D195").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesShape(ByRef num)
-Range("A196").Clear
-Range("B196").Clear
-Range("C196").Clear
-Range("D196").Clear
-Range("A196").Value = "xlDialogSeriesShape"
-Range("B196").Value = 504
-Range("C196").Value = num
-B196 = Range("B196").Value
-C196 = Range("C196").Value
-If B196 = C196 Then
-Range("D196").Value = "OK"
-Else
-Range("D196").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesX(ByRef num)
-Range("A197").Clear
-Range("B197").Clear
-Range("C197").Clear
-Range("D197").Clear
-Range("A197").Value = "xlDialogSeriesX"
-Range("B197").Value = 461
-Range("C197").Value = num
-B197 = Range("B197").Value
-C197 = Range("C197").Value
-If B197 = C197 Then
-Range("D197").Value = "OK"
-Else
-Range("D197").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesY(ByRef num)
-Range("A198").Clear
-Range("B198").Clear
-Range("C198").Clear
-Range("D198").Clear
-Range("A198").Value = "xlDialogSeriesY"
-Range("B198").Value = 462
-Range("C198").Value = num
-B198 = Range("B198").Value
-C198 = Range("C198").Value
-If B198 = C198 Then
-Range("D198").Value = "OK"
-Else
-Range("D198").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSetBackgroundPicture(ByRef num)
-Range("A199").Clear
-Range("B199").Clear
-Range("C199").Clear
-Range("D199").Clear
-Range("A199").Value = "xlDialogSetBackgroundPicture"
-Range("B199").Value = 509
-Range("C199").Value = num
-B199 = Range("B199").Value
-C199 = Range("C199").Value
-If B199 = C199 Then
-Range("D199").Value = "OK"
-Else
-Range("D199").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSetPrintTitles(ByRef num)
-Range("A200").Clear
-Range("B200").Clear
-Range("C200").Clear
-Range("D200").Clear
-Range("A200").Value = "xlDialogSetPrintTitles"
-Range("B200").Value = 23
-Range("C200").Value = num
-B200 = Range("B200").Value
-C200 = Range("C200").Value
-If B200 = C200 Then
-Range("D200").Value = "OK"
-Else
-Range("D200").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSetUpdateStatus(ByRef num)
-Range("A201").Clear
-Range("B201").Clear
-Range("C201").Clear
-Range("D201").Clear
-Range("A201").Value = "xlDialogSetUpdateStatus"
-Range("B201").Value = 159
-Range("C201").Value = num
-B201 = Range("B201").Value
-C201 = Range("C201").Value
-If B201 = C201 Then
-Range("D201").Value = "OK"
-Else
-Range("D201").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogShowDetail(ByRef num)
-Range("A202").Clear
-Range("B202").Clear
-Range("C202").Clear
-Range("D202").Clear
-Range("A202").Value = "xlDialogShowDetail"
-Range("B202").Value = 204
-Range("C202").Value = num
-B202 = Range("B202").Value
-C202 = Range("C202").Value
-If B202 = C202 Then
-Range("D202").Value = "OK"
-Else
-Range("D202").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogShowToolbar(ByRef num)
-Range("A203").Clear
-Range("B203").Clear
-Range("C203").Clear
-Range("D203").Clear
-Range("A203").Value = "xlDialogShowToolbar"
-Range("B203").Value = 220
-Range("C203").Value = num
-B203 = Range("B203").Value
-C203 = Range("C203").Value
-If B203 = C203 Then
-Range("D203").Value = "OK"
-Else
-Range("D203").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSize(ByRef num)
-Range("A204").Clear
-Range("B204").Clear
-Range("C204").Clear
-Range("D204").Clear
-Range("A204").Value = "xlDialogSize"
-Range("B204").Value = 261
-Range("C204").Value = num
-B204 = Range("B204").Value
-C204 = Range("C204").Value
-If B204 = C204 Then
-Range("D204").Value = "OK"
-Else
-Range("D204").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSort(ByRef num)
-Range("A205").Clear
-Range("B205").Clear
-Range("C205").Clear
-Range("D205").Clear
-Range("A205").Value = "xlDialogSort"
-Range("B205").Value = 39
-Range("C205").Value = num
-B205 = Range("B205").Value
-C205 = Range("C205").Value
-If B205 = C205 Then
-Range("D205").Value = "OK"
-Else
-Range("D205").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSortSpecial(ByRef num)
-Range("A206").Clear
-Range("B206").Clear
-Range("C206").Clear
-Range("D206").Clear
-Range("A206").Value = "xlDialogSortSpecial"
-Range("B206").Value = 192
-Range("C206").Value = num
-B206 = Range("B206").Value
-C206 = Range("C206").Value
-If B206 = C206 Then
-Range("D206").Value = "OK"
-Else
-Range("D206").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSplit(ByRef num)
-Range("A207").Clear
-Range("B207").Clear
-Range("C207").Clear
-Range("D207").Clear
-Range("A207").Value = "xlDialogSplit"
-Range("B207").Value = 137
-Range("C207").Value = num
-B207 = Range("B207").Value
-C207 = Range("C207").Value
-If B207 = C207 Then
-Range("D207").Value = "OK"
-Else
-Range("D207").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogStandardFont(ByRef num)
-Range("A208").Clear
-Range("B208").Clear
-Range("C208").Clear
-Range("D208").Clear
-Range("A208").Value = "xlDialogStandardFont"
-Range("B208").Value = 190
-Range("C208").Value = num
-B208 = Range("B208").Value
-C208 = Range("C208").Value
-If B208 = C208 Then
-Range("D208").Value = "OK"
-Else
-Range("D208").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogStandardWidth(ByRef num)
-Range("A209").Clear
-Range("B209").Clear
-Range("C209").Clear
-Range("D209").Clear
-Range("A209").Value = "xlDialogStandardWidth"
-Range("B209").Value = 472
-Range("C209").Value = num
-B209 = Range("B209").Value
-C209 = Range("C209").Value
-If B209 = C209 Then
-Range("D209").Value = "OK"
-Else
-Range("D209").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogStyle(ByRef num)
-Range("A210").Clear
-Range("B210").Clear
-Range("C210").Clear
-Range("D210").Clear
-Range("A210").Value = "xlDialogStyle"
-Range("B210").Value = 44
-Range("C210").Value = num
-B210 = Range("B210").Value
-C210 = Range("C210").Value
-If B210 = C210 Then
-Range("D210").Value = "OK"
-Else
-Range("D210").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSubscribeTo(ByRef num)
-Range("A211").Clear
-Range("B211").Clear
-Range("C211").Clear
-Range("D211").Clear
-Range("A211").Value = "xlDialogSubscribeTo"
-Range("B211").Value = 218
-Range("C211").Value = num
-B211 = Range("B211").Value
-C211 = Range("C211").Value
-If B211 = C211 Then
-Range("D211").Value = "OK"
-Else
-Range("D211").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSubtotalCreate(ByRef num)
-Range("A212").Clear
-Range("B212").Clear
-Range("C212").Clear
-Range("D212").Clear
-Range("A212").Value = "xlDialogSubtotalCreate"
-Range("B212").Value = 398
-Range("C212").Value = num
-B212 = Range("B212").Value
-C212 = Range("C212").Value
-If B212 = C212 Then
-Range("D212").Value = "OK"
-Else
-Range("D212").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSummaryInfo(ByRef num)
-Range("A213").Clear
-Range("B213").Clear
-Range("C213").Clear
-Range("D213").Clear
-Range("A213").Value = "xlDialogSummaryInfo"
-Range("B213").Value = 474
-Range("C213").Value = num
-B213 = Range("B213").Value
-C213 = Range("C213").Value
-If B213 = C213 Then
-Range("D213").Value = "OK"
-Else
-Range("D213").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogTable(ByRef num)
-Range("A214").Clear
-Range("B214").Clear
-Range("C214").Clear
-Range("D214").Clear
-Range("A214").Value = "xlDialogTable"
-Range("B214").Value = 41
-Range("C214").Value = num
-B214 = Range("B214").Value
-C214 = Range("C214").Value
-If B214 = C214 Then
-Range("D214").Value = "OK"
-Else
-Range("D214").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogTabOrder(ByRef num)
-Range("A215").Clear
-Range("B215").Clear
-Range("C215").Clear
-Range("D215").Clear
-Range("A215").Value = "xlDialogTabOrder"
-Range("B215").Value = 394
-Range("C215").Value = num
-B215 = Range("B215").Value
-C215 = Range("C215").Value
-If B215 = C215 Then
-Range("D215").Value = "OK"
-Else
-Range("D215").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogTextToColumns(ByRef num)
-Range("A216").Clear
-Range("B216").Clear
-Range("C216").Clear
-Range("D216").Clear
-Range("A216").Value = "xlDialogTextToColumns"
-Range("B216").Value = 422
-Range("C216").Value = num
-B216 = Range("B216").Value
-C216 = Range("C216").Value
-If B216 = C216 Then
-Range("D216").Value = "OK"
-Else
-Range("D216").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogUnhide(ByRef num)
-Range("A217").Clear
-Range("B217").Clear
-Range("C217").Clear
-Range("D217").Clear
-Range("A217").Value = "xlDialogUnhide"
-Range("B217").Value = 94
-Range("C217").Value = num
-B217 = Range("B217").Value
-C217 = Range("C217").Value
-If B217 = C217 Then
-Range("D217").Value = "OK"
-Else
-Range("D217").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogUpdateLink(ByRef num)
-Range("A218").Clear
-Range("B218").Clear
-Range("C218").Clear
-Range("D218").Clear
-Range("A218").Value = "xlDialogUpdateLink"
-Range("B218").Value = 201
-Range("C218").Value = num
-B218 = Range("B218").Value
-C218 = Range("C218").Value
-If B218 = C218 Then
-Range("D218").Value = "OK"
-Else
-Range("D218").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogVbaInsertFile(ByRef num)
-Range("A219").Clear
-Range("B219").Clear
-Range("C219").Clear
-Range("D219").Clear
-Range("A219").Value = "xlDialogVbaInsertFile"
-Range("B219").Value = 328
-Range("C219").Value = num
-B219 = Range("B219").Value
-C219 = Range("C219").Value
-If B219 = C219 Then
-Range("D219").Value = "OK"
-Else
-Range("D219").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogVbaMakeAddin(ByRef num)
-Range("A220").Clear
-Range("B220").Clear
-Range("C220").Clear
-Range("D220").Clear
-Range("A220").Value = "xlDialogVbaMakeAddin"
-Range("B220").Value = 478
-Range("C220").Value = num
-B220 = Range("B220").Value
-C220 = Range("C220").Value
-If B220 = C220 Then
-Range("D220").Value = "OK"
-Else
-Range("D220").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogVbaProcedureDefinition(ByRef num)
-Range("A221").Clear
-Range("B221").Clear
-Range("C221").Clear
-Range("D221").Clear
-Range("A221").Value = "xlDialogVbaProcedureDefinition"
-Range("B221").Value = 330
-Range("C221").Value = num
-B221 = Range("B221").Value
-C221 = Range("C221").Value
-If B221 = C221 Then
-Range("D221").Value = "OK"
-Else
-Range("D221").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogView3d(ByRef num)
-Range("A222").Clear
-Range("B222").Clear
-Range("C222").Clear
-Range("D222").Clear
-Range("A222").Value = "xlDialogView3d"
-Range("B222").Value = 197
-Range("C222").Value = num
-B222 = Range("B222").Value
-C222 = Range("C222").Value
-If B222 = C222 Then
-Range("D222").Value = "OK"
-Else
-Range("D222").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsBrowsers(ByRef num)
-Range("A223").Clear
-Range("B223").Clear
-Range("C223").Clear
-Range("D223").Clear
-Range("A223").Value = "xlDialogWebOptionsBrowsers"
-Range("B223").Value = 773
-Range("C223").Value = num
-B223 = Range("B223").Value
-C223 = Range("C223").Value
-If B223 = C223 Then
-Range("D223").Value = "OK"
-Else
-Range("D223").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsEncoding(ByRef num)
-Range("A224").Clear
-Range("B224").Clear
-Range("C224").Clear
-Range("D224").Clear
-Range("A224").Value = "xlDialogWebOptionsEncoding"
-Range("B224").Value = 686
-Range("C224").Value = num
-B224 = Range("B224").Value
-C224 = Range("C224").Value
-If B224 = C224 Then
-Range("D224").Value = "OK"
-Else
-Range("D224").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsFiles(ByRef num)
-Range("A225").Clear
-Range("B225").Clear
-Range("C225").Clear
-Range("D225").Clear
-Range("A225").Value = "xlDialogWebOptionsFiles"
-Range("B225").Value = 684
-Range("C225").Value = num
-B225 = Range("B225").Value
-C225 = Range("C225").Value
-If B225 = C225 Then
-Range("D225").Value = "OK"
-Else
-Range("D225").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsFonts(ByRef num)
-Range("A226").Clear
-Range("B226").Clear
-Range("C226").Clear
-Range("D226").Clear
-Range("A226").Value = "xlDialogWebOptionsFonts"
-Range("B226").Value = 687
-Range("C226").Value = num
-B226 = Range("B226").Value
-C226 = Range("C226").Value
-If B226 = C226 Then
-Range("D226").Value = "OK"
-Else
-Range("D226").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsGeneral(ByRef num)
-Range("A227").Clear
-Range("B227").Clear
-Range("C227").Clear
-Range("D227").Clear
-Range("A227").Value = "xlDialogWebOptionsGeneral"
-Range("B227").Value = 683
-Range("C227").Value = num
-B227 = Range("B227").Value
-C227 = Range("C227").Value
-If B227 = C227 Then
-Range("D227").Value = "OK"
-Else
-Range("D227").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsPictures(ByRef num)
-Range("A228").Clear
-Range("B228").Clear
-Range("C228").Clear
-Range("D228").Clear
-Range("A228").Value = "xlDialogWebOptionsPictures"
-Range("B228").Value = 685
-Range("C228").Value = num
-B228 = Range("B228").Value
-C228 = Range("C228").Value
-If B228 = C228 Then
-Range("D228").Value = "OK"
-Else
-Range("D228").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWindowMove(ByRef num)
-Range("A229").Clear
-Range("B229").Clear
-Range("C229").Clear
-Range("D229").Clear
-Range("A229").Value = "xlDialogWindowMove"
-Range("B229").Value = 14
-Range("C229").Value = num
-B229 = Range("B229").Value
-C229 = Range("C229").Value
-If B229 = C229 Then
-Range("D229").Value = "OK"
-Else
-Range("D229").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWindowSize(ByRef num)
-Range("A230").Clear
-Range("B230").Clear
-Range("C230").Clear
-Range("D230").Clear
-Range("A230").Value = "xlDialogWindowSize"
-Range("B230").Value = 13
-Range("C230").Value = num
-B230 = Range("B230").Value
-C230 = Range("C230").Value
-If B230 = C230 Then
-Range("D230").Value = "OK"
-Else
-Range("D230").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookAdd(ByRef num)
-Range("A231").Clear
-Range("B231").Clear
-Range("C231").Clear
-Range("D231").Clear
-Range("A231").Value = "xlDialogWorkbookAdd"
-Range("B231").Value = 281
-Range("C231").Value = num
-B231 = Range("B231").Value
-C231 = Range("C231").Value
-If B231 = C231 Then
-Range("D231").Value = "OK"
-Else
-Range("D231").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookCopy(ByRef num)
-Range("A232").Clear
-Range("B232").Clear
-Range("C232").Clear
-Range("D232").Clear
-Range("A232").Value = "xlDialogWorkbookCopy"
-Range("B232").Value = 283
-Range("C232").Value = num
-B232 = Range("B232").Value
-C232 = Range("C232").Value
-If B232 = C232 Then
-Range("D232").Value = "OK"
-Else
-Range("D232").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookInsert(ByRef num)
-Range("A233").Clear
-Range("B233").Clear
-Range("C233").Clear
-Range("D233").Clear
-Range("A233").Value = "xlDialogWorkbookInsert"
-Range("B233").Value = 354
-Range("C233").Value = num
-B233 = Range("B233").Value
-C233 = Range("C233").Value
-If B233 = C233 Then
-Range("D233").Value = "OK"
-Else
-Range("D233").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookMove(ByRef num)
-Range("A234").Clear
-Range("B234").Clear
-Range("C234").Clear
-Range("D234").Clear
-Range("A234").Value = "xlDialogWorkbookMove"
-Range("B234").Value = 282
-Range("C234").Value = num
-B234 = Range("B234").Value
-C234 = Range("C234").Value
-If B234 = C234 Then
-Range("D234").Value = "OK"
-Else
-Range("D234").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookName(ByRef num)
-Range("A235").Clear
-Range("B235").Clear
-Range("C235").Clear
-Range("D235").Clear
-Range("A235").Value = "xlDialogWorkbookName"
-Range("B235").Value = 386
-Range("C235").Value = num
-B235 = Range("B235").Value
-C235 = Range("C235").Value
-If B235 = C235 Then
-Range("D235").Value = "OK"
-Else
-Range("D235").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookNew(ByRef num)
-Range("A236").Clear
-Range("B236").Clear
-Range("C236").Clear
-Range("D236").Clear
-Range("A236").Value = "xlDialogWorkbookNew"
-Range("B236").Value = 302
-Range("C236").Value = num
-B236 = Range("B236").Value
-C236 = Range("C236").Value
-If B236 = C236 Then
-Range("D236").Value = "OK"
-Else
-Range("D236").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookOptions(ByRef num)
-Range("A237").Clear
-Range("B237").Clear
-Range("C237").Clear
-Range("D237").Clear
-Range("A237").Value = "xlDialogWorkbookOptions"
-Range("B237").Value = 284
-Range("C237").Value = num
-B237 = Range("B237").Value
-C237 = Range("C237").Value
-If B237 = C237 Then
-Range("D237").Value = "OK"
-Else
-Range("D237").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookProtect(ByRef num)
-Range("A238").Clear
-Range("B238").Clear
-Range("C238").Clear
-Range("D238").Clear
-Range("A238").Value = "xlDialogWorkbookProtect"
-Range("B238").Value = 417
-Range("C238").Value = num
-B238 = Range("B238").Value
-C238 = Range("C238").Value
-If B238 = C238 Then
-Range("D238").Value = "OK"
-Else
-Range("D238").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookTabSplit(ByRef num)
-Range("A239").Clear
-Range("B239").Clear
-Range("C239").Clear
-Range("D239").Clear
-Range("A239").Value = "xlDialogWorkbookTabSplit"
-Range("B239").Value = 415
-Range("C239").Value = num
-B239 = Range("B239").Value
-C239 = Range("C239").Value
-If B239 = C239 Then
-Range("D239").Value = "OK"
-Else
-Range("D239").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookUnhide(ByRef num)
-Range("A240").Clear
-Range("B240").Clear
-Range("C240").Clear
-Range("D240").Clear
-Range("A240").Value = "xlDialogWorkbookUnhide"
-Range("B240").Value = 384
-Range("C240").Value = num
-B240 = Range("B240").Value
-C240 = Range("C240").Value
-If B240 = C240 Then
-Range("D240").Value = "OK"
-Else
-Range("D240").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkgroup(ByRef num)
-Range("A241").Clear
-Range("B241").Clear
-Range("C241").Clear
-Range("D241").Clear
-Range("A241").Value = "xlDialogWorkgroup"
-Range("B241").Value = 199
-Range("C241").Value = num
-B241 = Range("B241").Value
-C241 = Range("C241").Value
-If B241 = C241 Then
-Range("D241").Value = "OK"
-Else
-Range("D241").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkspace(ByRef num)
-Range("A242").Clear
-Range("B242").Clear
-Range("C242").Clear
-Range("D242").Clear
-Range("A242").Value = "xlDialogWorkspace"
-Range("B242").Value = 95
-Range("C242").Value = num
-B242 = Range("B242").Value
-C242 = Range("C242").Value
-If B242 = C242 Then
-Range("D242").Value = "OK"
-Else
-Range("D242").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogZoom(ByRef num)
-Range("A243").Clear
-Range("B243").Clear
-Range("C243").Clear
-Range("D243").Clear
-Range("A243").Value = "xlDialogZoom"
-Range("B243").Value = 256
-Range("C243").Value = num
-B243 = Range("B243").Value
-C243 = Range("C243").Value
-If B243 = C243 Then
-Range("D243").Value = "OK"
-Else
-Range("D243").Value = "NG"
-End If
-End Function
-
-<<<<<<
-======================
-Module4
->>>>>>
-Attribute VB_Name = "Module4"
-
-Sub main_4()
-test_xlErrDiv0 (xlErrDiv0)
-test_xlErrNA (xlErrNA)
-test_xlErrName (xlErrName)
-test_xlErrNull (xlErrNull)
-test_xlErrNum (xlErrNum)
-test_xlErrRef (xlErrRef)
-test_xlErrValue (xlErrValue)
-test_xlCalculatedMember (xlCalculatedMember)
-test_xlCalculatedSet (xlCalculatedSet)
-test_xlCalculationAutomatic (xlCalculationAutomatic)
-test_xlCalculationManual (xlCalculationManual)
-test_xlCalculationSemiautomatic (xlCalculationSemiautomatic)
-test_xlAnyKey (xlAnyKey)
-test_xlEscKey (xlEscKey)
-test_xlNoKey (xlNoKey)
-test_xlCalculating (xlCalculating)
-test_xlDone (xlDone)
-test_xlPending (xlPending)
-test_xlAutomaticScale (xlAutomaticScale)
-test_xlCategoryScale (xlCategoryScale)
-test_xlTimeScale (xlTimeScale)
-test_xlInsertDeleteCells (xlInsertDeleteCells)
-test_xlInsertEntireRows (xlInsertEntireRows)
-test_xlOverwriteCells (xlOverwriteCells)
-test_xlCellTypeAllFormatConditions (xlCellTypeAllFormatConditions)
-test_xlCellTypeAllValidation (xlCellTypeAllValidation)
-test_xlCellTypeBlanks (xlCellTypeBlanks)
-test_xlCellTypeComments (xlCellTypeComments)
-test_xlCellTypeConstants (xlCellTypeConstants)
-test_xlCellTypeFormulas (xlCellTypeFormulas)
-test_xlCellTypeLastCell (xlCellTypeLastCell)
-test_xlCellTypeSameFormatConditions (xlCellTypeSameFormatConditions)
-test_xlCellTypeSameValidation (xlCellTypeSameValidation)
-test_xlCellTypeVisible (xlCellTypeVisible)
-test_xlAnyGallery (xlAnyGallery)
-test_xlBuildIn (xlBuildIn)
-test_xlUserDefined (xlUserDefined)
-test_xlAxis (xlAxis)
-test_xlAxisTitle (xlAxisTitle)
-test_xlChartTitle (xlChartTitle)
-test_xlCorners (xlCorners)
-test_xlDataLabel (xlDataLabel)
-test_xlDataTable (xlDataTable)
-test_xlDisplayUnitLabel (xlDisplayUnitLabel)
-test_xlDownBars (xlDownBars)
-test_xlDropLines (xlDropLines)
-test_xlErrorBars (xlErrorBars)
-test_xlFloor (xlFloor)
-test_xlHiLoLines (xlHiLoLines)
-test_xlLeaderLines (xlLeaderLines)
-test_xlLegend (xlLegend)
-test_xlLegendEntry (xlLegendEntry)
-test_xlLegendKey (xlLegendKey)
-test_xlMajorGridlines (xlMajorGridlines)
-test_xlMinorGridlines (xlMinorGridlines)
-test_xlNothing (xlNothing)
-test_xlPivotChartDropZone (xlPivotChartDropZone)
-test_xlPivotChartFieldButton (xlPivotChartFieldButton)
-test_xlPlotArea (xlPlotArea)
-test_xlRaderAxisLabels (xlRaderAxisLabels)
-test_xlSeries (xlSeries)
-test_xlSeriesLines (xlSeriesLines)
-test_xlShape (xlShape)
-test_xlTrendline (xlTrendline)
-test_xlUpBars (xlUpBars)
-test_xlWalls (xlWalls)
-test_xlXErrorBars (xlXErrorBars)
-test_xlYErrorBars (xlYErrorBars)
-test_xlLocationAsNewSheet (xlLocationAsNewSheet)
-test_xlLocationAsObject (xlLocationAsObject)
-test_xlLocationAutomatic (xlLocationAutomatic)
-test_xlAllFaces (xlAllFaces)
-test_xlEnd (xlEnd)
-test_xlEndSides (xlEndSides)
-test_xlFront (xlFront)
-test_xlFrontEnd (xlFrontEnd)
-test_xlFrontSides (xlFrontSides)
-test_xlSlides (xlSlides)
-test_xlStack (xlStack)
-test_xlStackScale (xlStackScale)
-test_xlStretch (xlStretch)
-test_xlSplitByCustomSplit (xlSplitByCustomSplit)
-test_xlSplitByPercentValue (xlSplitByPercentValue)
-test_xlSplitByPercentPosition (xlSplitByPercentPosition)
-test_xlSplitByValue (xlSplitByValue)
-test_xl3DArea (xl3DArea)
-test_xl3DAreaStacked (xl3DAreaStacked)
-test_xl3DAreaStacked100 (xl3DAreaStacked100)
-test_xl3DBarClustered (xl3DBarClustered)
-test_xl3DBarStacked (xl3DBarStacked)
-test_xl3DBarStacked100 (xl3DBarStacked100)
-test_xl3DColumn (xl3DColumn)
-test_xl3DColumnClustered (xl3DColumnClustered)
-test_xl3DColumnStacked (xl3DColumnStacked)
-test_xl3DColumnStacked100 (xl3DColumnStacked100)
-test_xl3DLine (xl3DLine)
-test_xl3DPie (xl3DPie)
-test_xl3DPieExploded (xl3DPieExploded)
-test_xlArea (xlArea)
-test_xlAreaStacked (xlAreaStacked)
-test_xlAreaStacked100 (xlAreaStacked100)
-test_xlBarClustered (xlBarClustered)
-test_xlBarOfPie (xlBarOfPie)
-test_xlBarStacked (xlBarStacked)
-test_xlBarStacked100 (xlBarStacked100)
-test_xlBubble (xlBubble)
-test_xlBubble3DEffect (xlBubble3DEffect)
-test_xlColumnClustered (xlColumnClustered)
-test_xlColumnStacked (xlColumnStacked)
-test_xlColumnStacked100 (xlColumnStacked100)
-test_xlConeBarClustered (xlConeBarClustered)
-test_xlConeBarStacked (xlConeBarStacked)
-test_xlConeBarStacked100 (xlConeBarStacked100)
-test_xlConeCol (xlConeCol)
-test_xlConeColClustered (xlConeColClustered)
-test_xlConeColStacked (xlConeColStacked)
-test_xlConeColStacked100 (xlConeColStacked100)
-test_xlCylinderBarClustered (xlCylinderBarClustered)
-test_xlCylinderBarStacked (xlCylinderBarStacked)
-test_xlCylinderBarStacked100 (xlCylinderBarStacked100)
-test_xlCylinderCol (xlCylinderCol)
-test_xlCylinderColClustered (xlCylinderColClustered)
-test_xlCylinderColStacked (xlCylinderColStacked)
-test_xlCylinderColStacked100 (xlCylinderColStacked100)
-test_xlDoughnut (xlDoughnut)
-test_xlDoughnutExploded (xlDoughnutExploded)
-test_xlLine (xlLine)
-test_xlLineMarkers (xlLineMarkers)
-test_xlLineMarkersStacked (xlLineMarkersStacked)
-test_xlLineMarkersStacked100 (xlLineMarkersStacked100)
-test_xlLineStacked (xlLineStacked)
-test_xlLineStacked100 (xlLineStacked100)
-test_xlPie (xlPie)
-test_xlPieExploded (xlPieExploded)
-test_xlPieOfPie (xlPieOfPie)
-test_xlPyramidBarClustered (xlPyramidBarClustered)
-test_xlPyramidBarStacked (xlPyramidBarStacked)
-test_xlPyramidBarStacked100 (xlPyramidBarStacked100)
-test_xlPyramidCol (xlPyramidCol)
-test_xlPyramidColClustered (xlPyramidColClustered)
-test_xlPyramidColStacked (xlPyramidColStacked)
-test_xlPyramidColStacked100 (xlPyramidColStacked100)
-test_xlRader (xlRader)
-test_xlRaderFilled (xlRaderFilled)
-test_xlRaderMarkers (xlRaderMarkers)
-test_xlStockHLC (xlStockHLC)
-test_xlStockOHLC (xlStockOHLC)
-test_xlStockVHLC (xlStockVHLC)
-test_xlStockVOHLC (xlStockVOHLC)
-test_xlSurface (xlSurface)
-test_xlSurfaceTopView (xlSurfaceTopView)
-test_xlSurfaceTopViewWireframe (xlSurfaceTopViewWireframe)
-test_xlSurfaceWireframe (xlSurfaceWireframe)
-test_xlXYScatter (xlXYScatter)
-test_xlXYScatterLines (xlXYScatterLines)
-test_xlXYScatterLinesNoMarkers (xlXYScatterLinesNoMarkers)
-test_xlXYScatterSmooth (xlXYScatterSmooth)
-test_xlXYScatterSmoothNoMarkers (xlXYScatterSmoothNoMarkers)
-test_xlClipboardFormatBIFF (xlClipboardFormatBIFF)
-test_xlClipboardFormatBIFF2 (xlClipboardFormatBIFF2)
-test_xlClipboardFormatBIFF3 (xlClipboardFormatBIFF3)
-test_xlClipboardFormatBIFF4 (xlClipboardFormatBIFF4)
-test_xlClipboardFormatBinary (xlClipboardFormatBinary)
-test_xlClipboardFormatBitmap (xlClipboardFormatBitmap)
-test_xlClipboardFormatCGM (xlClipboardFormatCGM)
-test_xlClipboardFormatCSV (xlClipboardFormatCSV)
-test_xlClipboardFormatDIF (xlClipboardFormatDIF)
-test_xlClipboardFormatDspText (xlClipboardFormatDspText)
-test_xlClipboardFormatEmbeddedObject (xlClipboardFormatEmbeddedObject)
-test_xlClipboardFormatEmbedSource (xlClipboardFormatEmbedSource)
-test_xlClipboardFormatLink (xlClipboardFormatLink)
-test_xlClipboardFormatLinkSource (xlClipboardFormatLinkSource)
-test_xlClipboardFormatLinkSourceDesc (xlClipboardFormatLinkSourceDesc)
-test_xlClipboardFormatMovie (xlClipboardFormatMovie)
-test_xlClipboardFormatNative (xlClipboardFormatNative)
-test_xlClipboardFormatObjectDesc (xlClipboardFormatObjectDesc)
-test_xlClipboardFormatObjectLink (xlClipboardFormatObjectLink)
-test_xlClipboardFormatOwnerLink (xlClipboardFormatOwnerLink)
-test_xlClipboardFormatPICT (xlClipboardFormatPICT)
-test_xlClipboardFormatPrintPICT (xlClipboardFormatPrintPICT)
-test_xlClipboardFormatRTF (xlClipboardFormatRTF)
-test_xlClipboardFormatScreenPICT (xlClipboardFormatScreenPICT)
-test_xlClipboardFormatStandardFont (xlClipboardFormatStandardFont)
-test_xlClipboardFormatStandardScale (xlClipboardFormatStandardScale)
-test_xlClipboardFormatSYLK (xlClipboardFormatSYLK)
-test_xlClipboardFormatTable (xlClipboardFormatTable)
-test_xlClipboardFormatText (xlClipboardFormatText)
-test_xlClipboardFormatToolFace (xlClipboardFormatToolFace)
-test_xlClipboardFormatToolFacePICT (xlClipboardFormatToolFacePICT)
-test_xlClipboardFormatToolVALU (xlClipboardFormatToolVALU)
-test_xlClipboardFormatToolWK1 (xlClipboardFormatToolWK1)
-test_xlCmdCube (xlCmdCube)
-test_xlCmdDefault (xlCmdDefault)
-test_xlCmdList (xlCmdList)
-test_xlCmdSql (xlCmdSql)
-test_xlCmdTable (xlCmdTable)
-test_xlColorIndexAutomatic (xlColorIndexAutomatic)
-test_xlColorIndexNone (xlColorIndexNone)
-test_xlDMYFormat (xlDMYFormat)
-test_xlDYMFormat (xlDYMFormat)
-test_xlEMDFormat (xlEMDFormat)
-test_xlGeneralFormat (xlGeneralFormat)
-test_xlMDYFormat (xlMDYFormat)
-test_xlMYDFormat (xlMYDFormat)
-test_xlSkipColumn (xlSkipColumn)
-test_xlTextFormat (xlTextFormat)
-test_xlYDMFormat (xlYDMFormat)
-test_xlYMDFormat (xlYMDFormat)
-test_xlCommandUnderlinesAutomatic (xlCommandUnderlinesAutomatic)
-test_xlCommandUnderlinesOff (xlCommandUnderlinesOff)
-test_xlCommandUnderlinesOn (xlCommandUnderlinesOn)
-test_xlCommentAndIndicator (xlCommentAndIndicator)
-test_xlCommentIndicatorOnly (xlCommentIndicatorOnly)
-test_xlNoIndicator (xlNoIndicator)
-test_xlAverage (xlAverage)
-test_xlCount (xlCount)
-test_xlCountNums (xlCountNums)
-test_xlMax (xlMax)
-test_xlMin (xlMin)
-test_xlProduct (xlProduct)
-test_xlStDev (xlStDev)
-test_xlStDevP (xlStDevP)
-test_xlSum (xlSum)
-test_xlUnknown (xlUnknown)
-test_xlVar (xlVar)
-test_xlVarP (xlVarP)
-test_xlBitmap (xlBitmap)
-test_xlPicture (xlPicture)
-test_xlExtractData (xlExtractData)
-test_xlNormalLoad (xlNormalLoad)
-test_xlRepairFile (xlRepairFile)
-test_xlCreatorCode (xlCreatorCode)
-test_xlHierarchy (xlHierarchy)
-test_xlMeasure (xlMeasure)
-test_xlSet (xlSet)
-test_xlCopy (xlCopy)
-test_xlCut (xlCut)
-test_xlValidAlterInformation (xlValidAlterInformation)
-test_xlValidAlterStop (xlValidAlterStop)
-test_xlValidAlterWarning (xlValidAlterWarning)
-test_xlValidateCustom (xlValidateCustom)
-test_xlValidateDate (xlValidateDate)
-test_xlValidateDecimal (xlValidateDecimal)
-test_xlValidateInputOnly (xlValidateInputOnly)
-test_xlValidateList (xlValidateList)
-test_xlValidateTextLength (xlValidateTextLength)
-test_xlValidateTime (xlValidateTime)
-test_xlValidateWholeNumber (xlValidateWholeNumber)
-test_xlLabelPositionAbove (xlLabelPositionAbove)
-test_xlLabelPositionBelow (xlLabelPositionBelow)
-test_xlLabelPositionBestFit (xlLabelPositionBestFit)
-test_xlLabelPositionBestCenter (xlLabelPositionBestCenter)
-test_xlLabelPositionBestCustom (xlLabelPositionBestCustom)
-test_xlLabelPositionInsideBase (xlLabelPositionInsideBase)
-test_xlLabelPositionInsideEnd (xlLabelPositionInsideEnd)
-test_xlLabelPositionInsideLeft (xlLabelPositionInsideLeft)
-test_xlLabelPositionMixed (xlLabelPositionMixed)
-test_xlLabelPositionOutsideEnd (xlLabelPositionOutsideEnd)
-test_xlLabelPositionRight (xlLabelPositionRight)
-test_xlDataLabelSeparatorDefault (xlDataLabelSeparatorDefault)
-test_xlDataLabelsShowBubbleSizes (xlDataLabelsShowBubbleSizes)
-test_xlDataLabelsShowLabel (xlDataLabelsShowLabel)
-test_xlDataLabelsShowLabelAndPercent (xlDataLabelsShowLabelAndPercent)
-test_xlDataLabelsShowNone (xlDataLabelsShowNone)
-test_xlDataLabelsShowPercent (xlDataLabelsShowPercent)
-test_xlDataLabelsShowValue (xlDataLabelsShowValue)
-test_xlDay (xlDay)
-test_xlMonth (xlMonth)
-test_xlWeekday (xlWeekday)
-test_xlYear (xlYear)
-test_xlAutoFill (xlAutoFill)
-test_xlChronological (xlChronological)
-test_xlDataSeriesLinear (xlDataSeriesLinear)
-test_xlGrowth (xlGrowth)
-test_xlShiftToLeft (xlShiftToLeft)
-test_xlShiftUp (xlShiftUp)
-test_xlDown (xlDown)
-test_xlToLeft (xlToLeft)
-test_xlToRight (xlToRight)
-test_xlUp (xlUp)
-test_xlInterpolated (xlInterpolated)
-test_xlNotPlotted (xlNotPlotted)
-test_xlZero (xlZero)
-test_xlDisplayShapes (xlDisplayShapes)
-test_xlHide (xlHide)
-test_xlPlaceholders (xlPlaceholders)
-test_xlHundredMillions (xlHundredMillions)
-test_xlHundreds (xlHundreds)
-test_xlHundredThousands (xlHundredThousands)
-test_xlMillionMillons (xlMillionMillons)
-test_xlMillions (xlMillions)
-test_xlTenMillions (xlTenMillions)
-test_xlTenThousands (xlTenThousands)
-test_xlThousandMillions (xlThousandMillions)
-test_xlThousands (xlThousands)
-Range("A1").Value = "constant name"
-Range("B1").Value = "OOo result"
-Range("C1").Value = "Excel result"
-Range("D1").Value = "Correct?"
-End Sub
-
-Function test_xlErrDiv0(ByRef num)
-Range("A2").Clear
-Range("B2").Clear
-Range("C2").Clear
-Range("D2").Clear
-Range("A2").Value = "xlErrDiv0"
-Range("B2").Value = 2007
-Range("C2").Value = num
-B2 = Range("B2").Value
-C2 = Range("C2").Value
-If B2 = C2 Then
-Range("D2").Value = "OK"
-Else
-Range("D2").Value = "NG"
-End If
-End Function
-
-Function test_xlErrNA(ByRef num)
-Range("A3").Clear
-Range("B3").Clear
-Range("C3").Clear
-Range("D3").Clear
-Range("A3").Value = "xlErrNA"
-Range("B3").Value = 2042
-Range("C3").Value = num
-B3 = Range("B3").Value
-C3 = Range("C3").Value
-If B3 = C3 Then
-Range("D3").Value = "OK"
-Else
-Range("D3").Value = "NG"
-End If
-End Function
-
-Function test_xlErrName(ByRef num)
-Range("A4").Clear
-Range("B4").Clear
-Range("C4").Clear
-Range("D4").Clear
-Range("A4").Value = "xlErrName"
-Range("B4").Value = 2029
-Range("C4").Value = num
-B4 = Range("B4").Value
-C4 = Range("C4").Value
-If B4 = C4 Then
-Range("D4").Value = "OK"
-Else
-Range("D4").Value = "NG"
-End If
-End Function
-
-Function test_xlErrNull(ByRef num)
-Range("A5").Clear
-Range("B5").Clear
-Range("C5").Clear
-Range("D5").Clear
-Range("A5").Value = "xlErrNull"
-Range("B5").Value = 2000
-Range("C5").Value = num
-B5 = Range("B5").Value
-C5 = Range("C5").Value
-If B5 = C5 Then
-Range("D5").Value = "OK"
-Else
-Range("D5").Value = "NG"
-End If
-End Function
-
-Function test_xlErrNum(ByRef num)
-Range("A6").Clear
-Range("B6").Clear
-Range("C6").Clear
-Range("D6").Clear
-Range("A6").Value = "xlErrNum"
-Range("B6").Value = 2036
-Range("C6").Value = num
-B6 = Range("B6").Value
-C6 = Range("C6").Value
-If B6 = C6 Then
-Range("D6").Value = "OK"
-Else
-Range("D6").Value = "NG"
-End If
-End Function
-
-Function test_xlErrRef(ByRef num)
-Range("A7").Clear
-Range("B7").Clear
-Range("C7").Clear
-Range("D7").Clear
-Range("A7").Value = "xlErrRef"
-Range("B7").Value = 2023
-Range("C7").Value = num
-B7 = Range("B7").Value
-C7 = Range("C7").Value
-If B7 = C7 Then
-Range("D7").Value = "OK"
-Else
-Range("D7").Value = "NG"
-End If
-End Function
-
-Function test_xlErrValue(ByRef num)
-Range("A8").Clear
-Range("B8").Clear
-Range("C8").Clear
-Range("D8").Clear
-Range("A8").Value = "xlErrValue"
-Range("B8").Value = 2015
-Range("C8").Value = num
-B8 = Range("B8").Value
-C8 = Range("C8").Value
-If B8 = C8 Then
-Range("D8").Value = "OK"
-Else
-Range("D8").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculatedMember(ByRef num)
-Range("A9").Clear
-Range("B9").Clear
-Range("C9").Clear
-Range("D9").Clear
-Range("A9").Value = "xlCalculatedMember"
-Range("B9").Value = 0
-Range("C9").Value = num
-B9 = Range("B9").Value
-C9 = Range("C9").Value
-If B9 = C9 Then
-Range("D9").Value = "OK"
-Else
-Range("D9").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculatedSet(ByRef num)
-Range("A10").Clear
-Range("B10").Clear
-Range("C10").Clear
-Range("D10").Clear
-Range("A10").Value = "xlCalculatedSet"
-Range("B10").Value = 1
-Range("C10").Value = num
-B10 = Range("B10").Value
-C10 = Range("C10").Value
-If B10 = C10 Then
-Range("D10").Value = "OK"
-Else
-Range("D10").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculationAutomatic(ByRef num)
-Range("A11").Clear
-Range("B11").Clear
-Range("C11").Clear
-Range("D11").Clear
-Range("A11").Value = "xlCalculationAutomatic"
-Range("B11").Value = -4105
-Range("C11").Value = num
-B11 = Range("B11").Value
-C11 = Range("C11").Value
-If B11 = C11 Then
-Range("D11").Value = "OK"
-Else
-Range("D11").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculationManual(ByRef num)
-Range("A12").Clear
-Range("B12").Clear
-Range("C12").Clear
-Range("D12").Clear
-Range("A12").Value = "xlCalculationManual"
-Range("B12").Value = -4135
-Range("C12").Value = num
-B12 = Range("B12").Value
-C12 = Range("C12").Value
-If B12 = C12 Then
-Range("D12").Value = "OK"
-Else
-Range("D12").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculationSemiautomatic(ByRef num)
-Range("A13").Clear
-Range("B13").Clear
-Range("C13").Clear
-Range("D13").Clear
-Range("A13").Value = "xlCalculationSemiautomatic"
-Range("B13").Value = 2
-Range("C13").Value = num
-B13 = Range("B13").Value
-C13 = Range("C13").Value
-If B13 = C13 Then
-Range("D13").Value = "OK"
-Else
-Range("D13").Value = "NG"
-End If
-End Function
-
-Function test_xlAnyKey(ByRef num)
-Range("A14").Clear
-Range("B14").Clear
-Range("C14").Clear
-Range("D14").Clear
-Range("A14").Value = "xlAnyKey"
-Range("B14").Value = 2
-Range("C14").Value = num
-B14 = Range("B14").Value
-C14 = Range("C14").Value
-If B14 = C14 Then
-Range("D14").Value = "OK"
-Else
-Range("D14").Value = "NG"
-End If
-End Function
-
-Function test_xlEscKey(ByRef num)
-Range("A15").Clear
-Range("B15").Clear
-Range("C15").Clear
-Range("D15").Clear
-Range("A15").Value = "xlEscKey"
-Range("B15").Value = 1
-Range("C15").Value = num
-B15 = Range("B15").Value
-C15 = Range("C15").Value
-If B15 = C15 Then
-Range("D15").Value = "OK"
-Else
-Range("D15").Value = "NG"
-End If
-End Function
-
-Function test_xlNoKey(ByRef num)
-Range("A16").Clear
-Range("B16").Clear
-Range("C16").Clear
-Range("D16").Clear
-Range("A16").Value = "xlNoKey"
-Range("B16").Value = 0
-Range("C16").Value = num
-B16 = Range("B16").Value
-C16 = Range("C16").Value
-If B16 = C16 Then
-Range("D16").Value = "OK"
-Else
-Range("D16").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculating(ByRef num)
-Range("A17").Clear
-Range("B17").Clear
-Range("C17").Clear
-Range("D17").Clear
-Range("A17").Value = "xlCalculating"
-Range("B17").Value = 1
-Range("C17").Value = num
-B17 = Range("B17").Value
-C17 = Range("C17").Value
-If B17 = C17 Then
-Range("D17").Value = "OK"
-Else
-Range("D17").Value = "NG"
-End If
-End Function
-
-Function test_xlDone(ByRef num)
-Range("A18").Clear
-Range("B18").Clear
-Range("C18").Clear
-Range("D18").Clear
-Range("A18").Value = "xlDone"
-Range("B18").Value = 0
-Range("C18").Value = num
-B18 = Range("B18").Value
-C18 = Range("C18").Value
-If B18 = C18 Then
-Range("D18").Value = "OK"
-Else
-Range("D18").Value = "NG"
-End If
-End Function
-
-Function test_xlPending(ByRef num)
-Range("A19").Clear
-Range("B19").Clear
-Range("C19").Clear
-Range("D19").Clear
-Range("A19").Value = "xlPending"
-Range("B19").Value = 2
-Range("C19").Value = num
-B19 = Range("B19").Value
-C19 = Range("C19").Value
-If B19 = C19 Then
-Range("D19").Value = "OK"
-Else
-Range("D19").Value = "NG"
-End If
-End Function
-
-Function test_xlAutomaticScale(ByRef num)
-Range("A20").Clear
-Range("B20").Clear
-Range("C20").Clear
-Range("D20").Clear
-Range("A20").Value = "xlAutomaticScale"
-Range("B20").Value = -4105
-Range("C20").Value = num
-B20 = Range("B20").Value
-C20 = Range("C20").Value
-If B20 = C20 Then
-Range("D20").Value = "OK"
-Else
-Range("D20").Value = "NG"
-End If
-End Function
-
-Function test_xlCategoryScale(ByRef num)
-Range("A21").Clear
-Range("B21").Clear
-Range("C21").Clear
-Range("D21").Clear
-Range("A21").Value = "xlCategoryScale"
-Range("B21").Value = 2
-Range("C21").Value = num
-B21 = Range("B21").Value
-C21 = Range("C21").Value
-If B21 = C21 Then
-Range("D21").Value = "OK"
-Else
-Range("D21").Value = "NG"
-End If
-End Function
-
-Function test_xlTimeScale(ByRef num)
-Range("A22").Clear
-Range("B22").Clear
-Range("C22").Clear
-Range("D22").Clear
-Range("A22").Value = "xlTimeScale"
-Range("B22").Value = 3
-Range("C22").Value = num
-B22 = Range("B22").Value
-C22 = Range("C22").Value
-If B22 = C22 Then
-Range("D22").Value = "OK"
-Else
-Range("D22").Value = "NG"
-End If
-End Function
-
-Function test_xlInsertDeleteCells(ByRef num)
-Range("A23").Clear
-Range("B23").Clear
-Range("C23").Clear
-Range("D23").Clear
-Range("A23").Value = "xlInsertDeleteCells"
-Range("B23").Value = 1
-Range("C23").Value = num
-B23 = Range("B23").Value
-C23 = Range("C23").Value
-If B23 = C23 Then
-Range("D23").Value = "OK"
-Else
-Range("D23").Value = "NG"
-End If
-End Function
-
-Function test_xlInsertEntireRows(ByRef num)
-Range("A24").Clear
-Range("B24").Clear
-Range("C24").Clear
-Range("D24").Clear
-Range("A24").Value = "xlInsertEntireRows"
-Range("B24").Value = 2
-Range("C24").Value = num
-B24 = Range("B24").Value
-C24 = Range("C24").Value
-If B24 = C24 Then
-Range("D24").Value = "OK"
-Else
-Range("D24").Value = "NG"
-End If
-End Function
-
-Function test_xlOverwriteCells(ByRef num)
-Range("A25").Clear
-Range("B25").Clear
-Range("C25").Clear
-Range("D25").Clear
-Range("A25").Value = "xlOverwriteCells"
-Range("B25").Value = 0
-Range("C25").Value = num
-B25 = Range("B25").Value
-C25 = Range("C25").Value
-If B25 = C25 Then
-Range("D25").Value = "OK"
-Else
-Range("D25").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeAllFormatConditions(ByRef num)
-Range("A26").Clear
-Range("B26").Clear
-Range("C26").Clear
-Range("D26").Clear
-Range("A26").Value = "xlCellTypeAllFormatConditions"
-Range("B26").Value = -4172
-Range("C26").Value = num
-B26 = Range("B26").Value
-C26 = Range("C26").Value
-If B26 = C26 Then
-Range("D26").Value = "OK"
-Else
-Range("D26").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeAllValidation(ByRef num)
-Range("A27").Clear
-Range("B27").Clear
-Range("C27").Clear
-Range("D27").Clear
-Range("A27").Value = "xlCellTypeAllValidation"
-Range("B27").Value = -4174
-Range("C27").Value = num
-B27 = Range("B27").Value
-C27 = Range("C27").Value
-If B27 = C27 Then
-Range("D27").Value = "OK"
-Else
-Range("D27").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeBlanks(ByRef num)
-Range("A28").Clear
-Range("B28").Clear
-Range("C28").Clear
-Range("D28").Clear
-Range("A28").Value = "xlCellTypeBlanks"
-Range("B28").Value = 4
-Range("C28").Value = num
-B28 = Range("B28").Value
-C28 = Range("C28").Value
-If B28 = C28 Then
-Range("D28").Value = "OK"
-Else
-Range("D28").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeComments(ByRef num)
-Range("A29").Clear
-Range("B29").Clear
-Range("C29").Clear
-Range("D29").Clear
-Range("A29").Value = "xlCellTypeComments"
-Range("B29").Value = -4144
-Range("C29").Value = num
-B29 = Range("B29").Value
-C29 = Range("C29").Value
-If B29 = C29 Then
-Range("D29").Value = "OK"
-Else
-Range("D29").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeConstants(ByRef num)
-Range("A30").Clear
-Range("B30").Clear
-Range("C30").Clear
-Range("D30").Clear
-Range("A30").Value = "xlCellTypeConstants"
-Range("B30").Value = 2
-Range("C30").Value = num
-B30 = Range("B30").Value
-C30 = Range("C30").Value
-If B30 = C30 Then
-Range("D30").Value = "OK"
-Else
-Range("D30").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeFormulas(ByRef num)
-Range("A31").Clear
-Range("B31").Clear
-Range("C31").Clear
-Range("D31").Clear
-Range("A31").Value = "xlCellTypeFormulas"
-Range("B31").Value = -4123
-Range("C31").Value = num
-B31 = Range("B31").Value
-C31 = Range("C31").Value
-If B31 = C31 Then
-Range("D31").Value = "OK"
-Else
-Range("D31").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeLastCell(ByRef num)
-Range("A32").Clear
-Range("B32").Clear
-Range("C32").Clear
-Range("D32").Clear
-Range("A32").Value = "xlCellTypeLastCell"
-Range("B32").Value = 11
-Range("C32").Value = num
-B32 = Range("B32").Value
-C32 = Range("C32").Value
-If B32 = C32 Then
-Range("D32").Value = "OK"
-Else
-Range("D32").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeSameFormatConditions(ByRef num)
-Range("A33").Clear
-Range("B33").Clear
-Range("C33").Clear
-Range("D33").Clear
-Range("A33").Value = "xlCellTypeSameFormatConditions"
-Range("B33").Value = -4173
-Range("C33").Value = num
-B33 = Range("B33").Value
-C33 = Range("C33").Value
-If B33 = C33 Then
-Range("D33").Value = "OK"
-Else
-Range("D33").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeSameValidation(ByRef num)
-Range("A34").Clear
-Range("B34").Clear
-Range("C34").Clear
-Range("D34").Clear
-Range("A34").Value = "xlCellTypeSameValidation"
-Range("B34").Value = -4175
-Range("C34").Value = num
-B34 = Range("B34").Value
-C34 = Range("C34").Value
-If B34 = C34 Then
-Range("D34").Value = "OK"
-Else
-Range("D34").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeVisible(ByRef num)
-Range("A35").Clear
-Range("B35").Clear
-Range("C35").Clear
-Range("D35").Clear
-Range("A35").Value = "xlCellTypeVisible"
-Range("B35").Value = 12
-Range("C35").Value = num
-B35 = Range("B35").Value
-C35 = Range("C35").Value
-If B35 = C35 Then
-Range("D35").Value = "OK"
-Else
-Range("D35").Value = "NG"
-End If
-End Function
-
-Function test_xlAnyGallery(ByRef num)
-Range("A36").Clear
-Range("B36").Clear
-Range("C36").Clear
-Range("D36").Clear
-Range("A36").Value = "xlAnyGallery"
-Range("B36").Value = 23
-Range("C36").Value = num
-B36 = Range("B36").Value
-C36 = Range("C36").Value
-If B36 = C36 Then
-Range("D36").Value = "OK"
-Else
-Range("D36").Value = "NG"
-End If
-End Function
-
-Function test_xlBuildIn(ByRef num)
-Range("A37").Clear
-Range("B37").Clear
-Range("C37").Clear
-Range("D37").Clear
-Range("A37").Value = "xlBuildIn"
-Range("B37").Value = 21
-Range("C37").Value = num
-B37 = Range("B37").Value
-C37 = Range("C37").Value
-If B37 = C37 Then
-Range("D37").Value = "OK"
-Else
-Range("D37").Value = "NG"
-End If
-End Function
-
-Function test_xlUserDefined(ByRef num)
-Range("A38").Clear
-Range("B38").Clear
-Range("C38").Clear
-Range("D38").Clear
-Range("A38").Value = "xlUserDefined"
-Range("B38").Value = 22
-Range("C38").Value = num
-B38 = Range("B38").Value
-C38 = Range("C38").Value
-If B38 = C38 Then
-Range("D38").Value = "OK"
-Else
-Range("D38").Value = "NG"
-End If
-End Function
-
-Function test_xlAxis(ByRef num)
-Range("A39").Clear
-Range("B39").Clear
-Range("C39").Clear
-Range("D39").Clear
-Range("A39").Value = "xlAxis"
-Range("B39").Value = 21
-Range("C39").Value = num
-B39 = Range("B39").Value
-C39 = Range("C39").Value
-If B39 = C39 Then
-Range("D39").Value = "OK"
-Else
-Range("D39").Value = "NG"
-End If
-End Function
-
-Function test_xlAxisTitle(ByRef num)
-Range("A40").Clear
-Range("B40").Clear
-Range("C40").Clear
-Range("D40").Clear
-Range("A40").Value = "xlAxisTitle"
-Range("B40").Value = 17
-Range("C40").Value = num
-B40 = Range("B40").Value
-C40 = Range("C40").Value
-If B40 = C40 Then
-Range("D40").Value = "OK"
-Else
-Range("D40").Value = "NG"
-End If
-End Function
-
-Function test_xlChartTitle(ByRef num)
-Range("A41").Clear
-Range("B41").Clear
-Range("C41").Clear
-Range("D41").Clear
-Range("A41").Value = "xlChartTitle"
-Range("B41").Value = 4
-Range("C41").Value = num
-B41 = Range("B41").Value
-C41 = Range("C41").Value
-If B41 = C41 Then
-Range("D41").Value = "OK"
-Else
-Range("D41").Value = "NG"
-End If
-End Function
-
-Function test_xlCorners(ByRef num)
-Range("A42").Clear
-Range("B42").Clear
-Range("C42").Clear
-Range("D42").Clear
-Range("A42").Value = "xlCorners"
-Range("B42").Value = 6
-Range("C42").Value = num
-B42 = Range("B42").Value
-C42 = Range("C42").Value
-If B42 = C42 Then
-Range("D42").Value = "OK"
-Else
-Range("D42").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabel(ByRef num)
-Range("A43").Clear
-Range("B43").Clear
-Range("C43").Clear
-Range("D43").Clear
-Range("A43").Value = "xlDataLabel"
-Range("B43").Value = 0
-Range("C43").Value = num
-B43 = Range("B43").Value
-C43 = Range("C43").Value
-If B43 = C43 Then
-Range("D43").Value = "OK"
-Else
-Range("D43").Value = "NG"
-End If
-End Function
-
-Function test_xlDataTable(ByRef num)
-Range("A44").Clear
-Range("B44").Clear
-Range("C44").Clear
-Range("D44").Clear
-Range("A44").Value = "xlDataTable"
-Range("B44").Value = 0
-Range("C44").Value = num
-B44 = Range("B44").Value
-C44 = Range("C44").Value
-If B44 = C44 Then
-Range("D44").Value = "OK"
-Else
-Range("D44").Value = "NG"
-End If
-End Function
-
-Function test_xlDisplayUnitLabel(ByRef num)
-Range("A45").Clear
-Range("B45").Clear
-Range("C45").Clear
-Range("D45").Clear
-Range("A45").Value = "xlDisplayUnitLabel"
-Range("B45").Value = 30
-Range("C45").Value = num
-B45 = Range("B45").Value
-C45 = Range("C45").Value
-If B45 = C45 Then
-Range("D45").Value = "OK"
-Else
-Range("D45").Value = "NG"
-End If
-End Function
-
-Function test_xlDownBars(ByRef num)
-Range("A46").Clear
-Range("B46").Clear
-Range("C46").Clear
-Range("D46").Clear
-Range("A46").Value = "xlDownBars"
-Range("B46").Value = 20
-Range("C46").Value = num
-B46 = Range("B46").Value
-C46 = Range("C46").Value
-If B46 = C46 Then
-Range("D46").Value = "OK"
-Else
-Range("D46").Value = "NG"
-End If
-End Function
-
-Function test_xlDropLines(ByRef num)
-Range("A47").Clear
-Range("B47").Clear
-Range("C47").Clear
-Range("D47").Clear
-Range("A47").Value = "xlDropLines"
-Range("B47").Value = 26
-Range("C47").Value = num
-B47 = Range("B47").Value
-C47 = Range("C47").Value
-If B47 = C47 Then
-Range("D47").Value = "OK"
-Else
-Range("D47").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBars(ByRef num)
-Range("A48").Clear
-Range("B48").Clear
-Range("C48").Clear
-Range("D48").Clear
-Range("A48").Value = "xlErrorBars"
-Range("B48").Value = 9
-Range("C48").Value = num
-B48 = Range("B48").Value
-C48 = Range("C48").Value
-If B48 = C48 Then
-Range("D48").Value = "OK"
-Else
-Range("D48").Value = "NG"
-End If
-End Function
-
-Function test_xlFloor(ByRef num)
-Range("A49").Clear
-Range("B49").Clear
-Range("C49").Clear
-Range("D49").Clear
-Range("A49").Value = "xlFloor"
-Range("B49").Value = 23
-Range("C49").Value = num
-B49 = Range("B49").Value
-C49 = Range("C49").Value
-If B49 = C49 Then
-Range("D49").Value = "OK"
-Else
-Range("D49").Value = "NG"
-End If
-End Function
-
-Function test_xlHiLoLines(ByRef num)
-Range("A50").Clear
-Range("B50").Clear
-Range("C50").Clear
-Range("D50").Clear
-Range("A50").Value = "xlHiLoLines"
-Range("B50").Value = 25
-Range("C50").Value = num
-B50 = Range("B50").Value
-C50 = Range("C50").Value
-If B50 = C50 Then
-Range("D50").Value = "OK"
-Else
-Range("D50").Value = "NG"
-End If
-End Function
-
-Function test_xlLeaderLines(ByRef num)
-Range("A51").Clear
-Range("B51").Clear
-Range("C51").Clear
-Range("D51").Clear
-Range("A51").Value = "xlLeaderLines"
-Range("B51").Value = 29
-Range("C51").Value = num
-B51 = Range("B51").Value
-C51 = Range("C51").Value
-If B51 = C51 Then
-Range("D51").Value = "OK"
-Else
-Range("D51").Value = "NG"
-End If
-End Function
-
-Function test_xlLegend(ByRef num)
-Range("A52").Clear
-Range("B52").Clear
-Range("C52").Clear
-Range("D52").Clear
-Range("A52").Value = "xlLegend"
-Range("B52").Value = 24
-Range("C52").Value = num
-B52 = Range("B52").Value
-C52 = Range("C52").Value
-If B52 = C52 Then
-Range("D52").Value = "OK"
-Else
-Range("D52").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendEntry(ByRef num)
-Range("A53").Clear
-Range("B53").Clear
-Range("C53").Clear
-Range("D53").Clear
-Range("A53").Value = "xlLegendEntry"
-Range("B53").Value = 12
-Range("C53").Value = num
-B53 = Range("B53").Value
-C53 = Range("C53").Value
-If B53 = C53 Then
-Range("D53").Value = "OK"
-Else
-Range("D53").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendKey(ByRef num)
-Range("A54").Clear
-Range("B54").Clear
-Range("C54").Clear
-Range("D54").Clear
-Range("A54").Value = "xlLegendKey"
-Range("B54").Value = 13
-Range("C54").Value = num
-B54 = Range("B54").Value
-C54 = Range("C54").Value
-If B54 = C54 Then
-Range("D54").Value = "OK"
-Else
-Range("D54").Value = "NG"
-End If
-End Function
-
-Function test_xlMajorGridlines(ByRef num)
-Range("A55").Clear
-Range("B55").Clear
-Range("C55").Clear
-Range("D55").Clear
-Range("A55").Value = "xlMajorGridlines"
-Range("B55").Value = 15
-Range("C55").Value = num
-B55 = Range("B55").Value
-C55 = Range("C55").Value
-If B55 = C55 Then
-Range("D55").Value = "OK"
-Else
-Range("D55").Value = "NG"
-End If
-End Function
-
-Function test_xlMinorGridlines(ByRef num)
-Range("A56").Clear
-Range("B56").Clear
-Range("C56").Clear
-Range("D56").Clear
-Range("A56").Value = "xlMinorGridlines"
-Range("B56").Value = 16
-Range("C56").Value = num
-B56 = Range("B56").Value
-C56 = Range("C56").Value
-If B56 = C56 Then
-Range("D56").Value = "OK"
-Else
-Range("D56").Value = "NG"
-End If
-End Function
-
-Function test_xlNothing(ByRef num)
-Range("A57").Clear
-Range("B57").Clear
-Range("C57").Clear
-Range("D57").Clear
-Range("A57").Value = "xlNothing"
-Range("B57").Value = 28
-Range("C57").Value = num
-B57 = Range("B57").Value
-C57 = Range("C57").Value
-If B57 = C57 Then
-Range("D57").Value = "OK"
-Else
-Range("D57").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotChartDropZone(ByRef num)
-Range("A58").Clear
-Range("B58").Clear
-Range("C58").Clear
-Range("D58").Clear
-Range("A58").Value = "xlPivotChartDropZone"
-Range("B58").Value = 32
-Range("C58").Value = num
-B58 = Range("B58").Value
-C58 = Range("C58").Value
-If B58 = C58 Then
-Range("D58").Value = "OK"
-Else
-Range("D58").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotChartFieldButton(ByRef num)
-Range("A59").Clear
-Range("B59").Clear
-Range("C59").Clear
-Range("D59").Clear
-Range("A59").Value = "xlPivotChartFieldButton"
-Range("B59").Value = 31
-Range("C59").Value = num
-B59 = Range("B59").Value
-C59 = Range("C59").Value
-If B59 = C59 Then
-Range("D59").Value = "OK"
-Else
-Range("D59").Value = "NG"
-End If
-End Function
-
-Function test_xlPlotArea(ByRef num)
-Range("A60").Clear
-Range("B60").Clear
-Range("C60").Clear
-Range("D60").Clear
-Range("A60").Value = "xlPlotArea"
-Range("B60").Value = 19
-Range("C60").Value = num
-B60 = Range("B60").Value
-C60 = Range("C60").Value
-If B60 = C60 Then
-Range("D60").Value = "OK"
-Else
-Range("D60").Value = "NG"
-End If
-End Function
-
-Function test_xlRaderAxisLabels(ByRef num)
-Range("A61").Clear
-Range("B61").Clear
-Range("C61").Clear
-Range("D61").Clear
-Range("A61").Value = "xlRaderAxisLabels"
-Range("B61").Value = 27
-Range("C61").Value = num
-B61 = Range("B61").Value
-C61 = Range("C61").Value
-If B61 = C61 Then
-Range("D61").Value = "OK"
-Else
-Range("D61").Value = "NG"
-End If
-End Function
-
-Function test_xlSeries(ByRef num)
-Range("A62").Clear
-Range("B62").Clear
-Range("C62").Clear
-Range("D62").Clear
-Range("A62").Value = "xlSeries"
-Range("B62").Value = 3
-Range("C62").Value = num
-B62 = Range("B62").Value
-C62 = Range("C62").Value
-If B62 = C62 Then
-Range("D62").Value = "OK"
-Else
-Range("D62").Value = "NG"
-End If
-End Function
-
-Function test_xlSeriesLines(ByRef num)
-Range("A63").Clear
-Range("B63").Clear
-Range("C63").Clear
-Range("D63").Clear
-Range("A63").Value = "xlSeriesLines"
-Range("B63").Value = 22
-Range("C63").Value = num
-B63 = Range("B63").Value
-C63 = Range("C63").Value
-If B63 = C63 Then
-Range("D63").Value = "OK"
-Else
-Range("D63").Value = "NG"
-End If
-End Function
-
-Function test_xlShape(ByRef num)
-Range("A64").Clear
-Range("B64").Clear
-Range("C64").Clear
-Range("D64").Clear
-Range("A64").Value = "xlShape"
-Range("B64").Value = 14
-Range("C64").Value = num
-B64 = Range("B64").Value
-C64 = Range("C64").Value
-If B64 = C64 Then
-Range("D64").Value = "OK"
-Else
-Range("D64").Value = "NG"
-End If
-End Function
-
-Function test_xlTrendline(ByRef num)
-Range("A65").Clear
-Range("B65").Clear
-Range("C65").Clear
-Range("D65").Clear
-Range("A65").Value = "xlTrendline"
-Range("B65").Value = 8
-Range("C65").Value = num
-B65 = Range("B65").Value
-C65 = Range("C65").Value
-If B65 = C65 Then
-Range("D65").Value = "OK"
-Else
-Range("D65").Value = "NG"
-End If
-End Function
-
-Function test_xlUpBars(ByRef num)
-Range("A66").Clear
-Range("B66").Clear
-Range("C66").Clear
-Range("D66").Clear
-Range("A66").Value = "xlUpBars"
-Range("B66").Value = 18
-Range("C66").Value = num
-B66 = Range("B66").Value
-C66 = Range("C66").Value
-If B66 = C66 Then
-Range("D66").Value = "OK"
-Else
-Range("D66").Value = "NG"
-End If
-End Function
-
-Function test_xlWalls(ByRef num)
-Range("A67").Clear
-Range("B67").Clear
-Range("C67").Clear
-Range("D67").Clear
-Range("A67").Value = "xlWalls"
-Range("B67").Value = 5
-Range("C67").Value = num
-B67 = Range("B67").Value
-C67 = Range("C67").Value
-If B67 = C67 Then
-Range("D67").Value = "OK"
-Else
-Range("D67").Value = "NG"
-End If
-End Function
-
-Function test_xlXErrorBars(ByRef num)
-Range("A68").Clear
-Range("B68").Clear
-Range("C68").Clear
-Range("D68").Clear
-Range("A68").Value = "xlXErrorBars"
-Range("B68").Value = 10
-Range("C68").Value = num
-B68 = Range("B68").Value
-C68 = Range("C68").Value
-If B68 = C68 Then
-Range("D68").Value = "OK"
-Else
-Range("D68").Value = "NG"
-End If
-End Function
-
-Function test_xlYErrorBars(ByRef num)
-Range("A69").Clear
-Range("B69").Clear
-Range("C69").Clear
-Range("D69").Clear
-Range("A69").Value = "xlYErrorBars"
-Range("B69").Value = 11
-Range("C69").Value = num
-B69 = Range("B69").Value
-C69 = Range("C69").Value
-If B69 = C69 Then
-Range("D69").Value = "OK"
-Else
-Range("D69").Value = "NG"
-End If
-End Function
-
-Function test_xlLocationAsNewSheet(ByRef num)
-Range("A70").Clear
-Range("B70").Clear
-Range("C70").Clear
-Range("D70").Clear
-Range("A70").Value = "xlLocationAsNewSheet"
-Range("B70").Value = 1
-Range("C70").Value = num
-B70 = Range("B70").Value
-C70 = Range("C70").Value
-If B70 = C70 Then
-Range("D70").Value = "OK"
-Else
-Range("D70").Value = "NG"
-End If
-End Function
-
-Function test_xlLocationAsObject(ByRef num)
-Range("A71").Clear
-Range("B71").Clear
-Range("C71").Clear
-Range("D71").Clear
-Range("A71").Value = "xlLocationAsObject"
-Range("B71").Value = 2
-Range("C71").Value = num
-B71 = Range("B71").Value
-C71 = Range("C71").Value
-If B71 = C71 Then
-Range("D71").Value = "OK"
-Else
-Range("D71").Value = "NG"
-End If
-End Function
-
-Function test_xlLocationAutomatic(ByRef num)
-Range("A72").Clear
-Range("B72").Clear
-Range("C72").Clear
-Range("D72").Clear
-Range("A72").Value = "xlLocationAutomatic"
-Range("B72").Value = 3
-Range("C72").Value = num
-B72 = Range("B72").Value
-C72 = Range("C72").Value
-If B72 = C72 Then
-Range("D72").Value = "OK"
-Else
-Range("D72").Value = "NG"
-End If
-End Function
-
-Function test_xlAllFaces(ByRef num)
-Range("A73").Clear
-Range("B73").Clear
-Range("C73").Clear
-Range("D73").Clear
-Range("A73").Value = "xlAllFaces"
-Range("B73").Value = 7
-Range("C73").Value = num
-B73 = Range("B73").Value
-C73 = Range("C73").Value
-If B73 = C73 Then
-Range("D73").Value = "OK"
-Else
-Range("D73").Value = "NG"
-End If
-End Function
-
-Function test_xlEnd(ByRef num)
-Range("A74").Clear
-Range("B74").Clear
-Range("C74").Clear
-Range("D74").Clear
-Range("A74").Value = "xlEnd"
-Range("B74").Value = 2
-Range("C74").Value = num
-B74 = Range("B74").Value
-C74 = Range("C74").Value
-If B74 = C74 Then
-Range("D74").Value = "OK"
-Else
-Range("D74").Value = "NG"
-End If
-End Function
-
-Function test_xlEndSides(ByRef num)
-Range("A75").Clear
-Range("B75").Clear
-Range("C75").Clear
-Range("D75").Clear
-Range("A75").Value = "xlEndSides"
-Range("B75").Value = 3
-Range("C75").Value = num
-B75 = Range("B75").Value
-C75 = Range("C75").Value
-If B75 = C75 Then
-Range("D75").Value = "OK"
-Else
-Range("D75").Value = "NG"
-End If
-End Function
-
-Function test_xlFront(ByRef num)
-Range("A76").Clear
-Range("B76").Clear
-Range("C76").Clear
-Range("D76").Clear
-Range("A76").Value = "xlFront"
-Range("B76").Value = 4
-Range("C76").Value = num
-B76 = Range("B76").Value
-C76 = Range("C76").Value
-If B76 = C76 Then
-Range("D76").Value = "OK"
-Else
-Range("D76").Value = "NG"
-End If
-End Function
-
-Function test_xlFrontEnd(ByRef num)
-Range("A77").Clear
-Range("B77").Clear
-Range("C77").Clear
-Range("D77").Clear
-Range("A77").Value = "xlFrontEnd"
-Range("B77").Value = 6
-Range("C77").Value = num
-B77 = Range("B77").Value
-C77 = Range("C77").Value
-If B77 = C77 Then
-Range("D77").Value = "OK"
-Else
-Range("D77").Value = "NG"
-End If
-End Function
-
-Function test_xlFrontSides(ByRef num)
-Range("A78").Clear
-Range("B78").Clear
-Range("C78").Clear
-Range("D78").Clear
-Range("A78").Value = "xlFrontSides"
-Range("B78").Value = 5
-Range("C78").Value = num
-B78 = Range("B78").Value
-C78 = Range("C78").Value
-If B78 = C78 Then
-Range("D78").Value = "OK"
-Else
-Range("D78").Value = "NG"
-End If
-End Function
-
-Function test_xlSlides(ByRef num)
-Range("A79").Clear
-Range("B79").Clear
-Range("C79").Clear
-Range("D79").Clear
-Range("A79").Value = "xlSlides"
-Range("B79").Value = 1
-Range("C79").Value = num
-B79 = Range("B79").Value
-C79 = Range("C79").Value
-If B79 = C79 Then
-Range("D79").Value = "OK"
-Else
-Range("D79").Value = "NG"
-End If
-End Function
-
-Function test_xlStack(ByRef num)
-Range("A80").Clear
-Range("B80").Clear
-Range("C80").Clear
-Range("D80").Clear
-Range("A80").Value = "xlStack"
-Range("B80").Value = 2
-Range("C80").Value = num
-B80 = Range("B80").Value
-C80 = Range("C80").Value
-If B80 = C80 Then
-Range("D80").Value = "OK"
-Else
-Range("D80").Value = "NG"
-End If
-End Function
-
-Function test_xlStackScale(ByRef num)
-Range("A81").Clear
-Range("B81").Clear
-Range("C81").Clear
-Range("D81").Clear
-Range("A81").Value = "xlStackScale"
-Range("B81").Value = 3
-Range("C81").Value = num
-B81 = Range("B81").Value
-C81 = Range("C81").Value
-If B81 = C81 Then
-Range("D81").Value = "OK"
-Else
-Range("D81").Value = "NG"
-End If
-End Function
-
-Function test_xlStretch(ByRef num)
-Range("A82").Clear
-Range("B82").Clear
-Range("C82").Clear
-Range("D82").Clear
-Range("A82").Value = "xlStretch"
-Range("B82").Value = 1
-Range("C82").Value = num
-B82 = Range("B82").Value
-C82 = Range("C82").Value
-If B82 = C82 Then
-Range("D82").Value = "OK"
-Else
-Range("D82").Value = "NG"
-End If
-End Function
-
-Function test_xlSplitByCustomSplit(ByRef num)
-Range("A83").Clear
-Range("B83").Clear
-Range("C83").Clear
-Range("D83").Clear
-Range("A83").Value = "xlSplitByCustomSplit"
-Range("B83").Value = 4
-Range("C83").Value = num
-B83 = Range("B83").Value
-C83 = Range("C83").Value
-If B83 = C83 Then
-Range("D83").Value = "OK"
-Else
-Range("D83").Value = "NG"
-End If
-End Function
-
-Function test_xlSplitByPercentValue(ByRef num)
-Range("A84").Clear
-Range("B84").Clear
-Range("C84").Clear
-Range("D84").Clear
-Range("A84").Value = "xlSplitByPercentValue"
-Range("B84").Value = 3
-Range("C84").Value = num
-B84 = Range("B84").Value
-C84 = Range("C84").Value
-If B84 = C84 Then
-Range("D84").Value = "OK"
-Else
-Range("D84").Value = "NG"
-End If
-End Function
-
-Function test_xlSplitByPercentPosition(ByRef num)
-Range("A85").Clear
-Range("B85").Clear
-Range("C85").Clear
-Range("D85").Clear
-Range("A85").Value = "xlSplitByPercentPosition"
-Range("B85").Value = 1
-Range("C85").Value = num
-B85 = Range("B85").Value
-C85 = Range("C85").Value
-If B85 = C85 Then
-Range("D85").Value = "OK"
-Else
-Range("D85").Value = "NG"
-End If
-End Function
-
-Function test_xlSplitByValue(ByRef num)
-Range("A86").Clear
-Range("B86").Clear
-Range("C86").Clear
-Range("D86").Clear
-Range("A86").Value = "xlSplitByValue"
-Range("B86").Value = 2
-Range("C86").Value = num
-B86 = Range("B86").Value
-C86 = Range("C86").Value
-If B86 = C86 Then
-Range("D86").Value = "OK"
-Else
-Range("D86").Value = "NG"
-End If
-End Function
-
-Function test_xl3DArea(ByRef num)
-Range("A87").Clear
-Range("B87").Clear
-Range("C87").Clear
-Range("D87").Clear
-Range("A87").Value = "xl3DArea"
-Range("B87").Value = -4098
-Range("C87").Value = num
-B87 = Range("B87").Value
-C87 = Range("C87").Value
-If B87 = C87 Then
-Range("D87").Value = "OK"
-Else
-Range("D87").Value = "NG"
-End If
-End Function
-
-Function test_xl3DAreaStacked(ByRef num)
-Range("A88").Clear
-Range("B88").Clear
-Range("C88").Clear
-Range("D88").Clear
-Range("A88").Value = "xl3DAreaStacked"
-Range("B88").Value = 78
-Range("C88").Value = num
-B88 = Range("B88").Value
-C88 = Range("C88").Value
-If B88 = C88 Then
-Range("D88").Value = "OK"
-Else
-Range("D88").Value = "NG"
-End If
-End Function
-
-Function test_xl3DAreaStacked100(ByRef num)
-Range("A89").Clear
-Range("B89").Clear
-Range("C89").Clear
-Range("D89").Clear
-Range("A89").Value = "xl3DAreaStacked100"
-Range("B89").Value = 79
-Range("C89").Value = num
-B89 = Range("B89").Value
-C89 = Range("C89").Value
-If B89 = C89 Then
-Range("D89").Value = "OK"
-Else
-Range("D89").Value = "NG"
-End If
-End Function
-
-Function test_xl3DBarClustered(ByRef num)
-Range("A90").Clear
-Range("B90").Clear
-Range("C90").Clear
-Range("D90").Clear
-Range("A90").Value = "xl3DBarClustered"
-Range("B90").Value = 60
-Range("C90").Value = num
-B90 = Range("B90").Value
-C90 = Range("C90").Value
-If B90 = C90 Then
-Range("D90").Value = "OK"
-Else
-Range("D90").Value = "NG"
-End If
-End Function
-
-Function test_xl3DBarStacked(ByRef num)
-Range("A91").Clear
-Range("B91").Clear
-Range("C91").Clear
-Range("D91").Clear
-Range("A91").Value = "xl3DBarStacked"
-Range("B91").Value = 61
-Range("C91").Value = num
-B91 = Range("B91").Value
-C91 = Range("C91").Value
-If B91 = C91 Then
-Range("D91").Value = "OK"
-Else
-Range("D91").Value = "NG"
-End If
-End Function
-
-Function test_xl3DBarStacked100(ByRef num)
-Range("A92").Clear
-Range("B92").Clear
-Range("C92").Clear
-Range("D92").Clear
-Range("A92").Value = "xl3DBarStacked100"
-Range("B92").Value = 62
-Range("C92").Value = num
-B92 = Range("B92").Value
-C92 = Range("C92").Value
-If B92 = C92 Then
-Range("D92").Value = "OK"
-Else
-Range("D92").Value = "NG"
-End If
-End Function
-
-Function test_xl3DColumn(ByRef num)
-Range("A93").Clear
-Range("B93").Clear
-Range("C93").Clear
-Range("D93").Clear
-Range("A93").Value = "xl3DColumn"
-Range("B93").Value = -4100
-Range("C93").Value = num
-B93 = Range("B93").Value
-C93 = Range("C93").Value
-If B93 = C93 Then
-Range("D93").Value = "OK"
-Else
-Range("D93").Value = "NG"
-End If
-End Function
-
-Function test_xl3DColumnClustered(ByRef num)
-Range("A94").Clear
-Range("B94").Clear
-Range("C94").Clear
-Range("D94").Clear
-Range("A94").Value = "xl3DColumnClustered"
-Range("B94").Value = 54
-Range("C94").Value = num
-B94 = Range("B94").Value
-C94 = Range("C94").Value
-If B94 = C94 Then
-Range("D94").Value = "OK"
-Else
-Range("D94").Value = "NG"
-End If
-End Function
-
-Function test_xl3DColumnStacked(ByRef num)
-Range("A95").Clear
-Range("B95").Clear
-Range("C95").Clear
-Range("D95").Clear
-Range("A95").Value = "xl3DColumnStacked"
-Range("B95").Value = 55
-Range("C95").Value = num
-B95 = Range("B95").Value
-C95 = Range("C95").Value
-If B95 = C95 Then
-Range("D95").Value = "OK"
-Else
-Range("D95").Value = "NG"
-End If
-End Function
-
-Function test_xl3DColumnStacked100(ByRef num)
-Range("A96").Clear
-Range("B96").Clear
-Range("C96").Clear
-Range("D96").Clear
-Range("A96").Value = "xl3DColumnStacked100"
-Range("B96").Value = 56
-Range("C96").Value = num
-B96 = Range("B96").Value
-C96 = Range("C96").Value
-If B96 = C96 Then
-Range("D96").Value = "OK"
-Else
-Range("D96").Value = "NG"
-End If
-End Function
-
-Function test_xl3DLine(ByRef num)
-Range("A97").Clear
-Range("B97").Clear
-Range("C97").Clear
-Range("D97").Clear
-Range("A97").Value = "xl3DLine"
-Range("B97").Value = -4101
-Range("C97").Value = num
-B97 = Range("B97").Value
-C97 = Range("C97").Value
-If B97 = C97 Then
-Range("D97").Value = "OK"
-Else
-Range("D97").Value = "NG"
-End If
-End Function
-
-Function test_xl3DPie(ByRef num)
-Range("A98").Clear
-Range("B98").Clear
-Range("C98").Clear
-Range("D98").Clear
-Range("A98").Value = "xl3DPie"
-Range("B98").Value = -4102
-Range("C98").Value = num
-B98 = Range("B98").Value
-C98 = Range("C98").Value
-If B98 = C98 Then
-Range("D98").Value = "OK"
-Else
-Range("D98").Value = "NG"
-End If
-End Function
-
-Function test_xl3DPieExploded(ByRef num)
-Range("A99").Clear
-Range("B99").Clear
-Range("C99").Clear
-Range("D99").Clear
-Range("A99").Value = "xl3DPieExploded"
-Range("B99").Value = 70
-Range("C99").Value = num
-B99 = Range("B99").Value
-C99 = Range("C99").Value
-If B99 = C99 Then
-Range("D99").Value = "OK"
-Else
-Range("D99").Value = "NG"
-End If
-End Function
-
-Function test_xlArea(ByRef num)
-Range("A100").Clear
-Range("B100").Clear
-Range("C100").Clear
-Range("D100").Clear
-Range("A100").Value = "xlArea"
-Range("B100").Value = 1
-Range("C100").Value = num
-B100 = Range("B100").Value
-C100 = Range("C100").Value
-If B100 = C100 Then
-Range("D100").Value = "OK"
-Else
-Range("D100").Value = "NG"
-End If
-End Function
-
-Function test_xlAreaStacked(ByRef num)
-Range("A101").Clear
-Range("B101").Clear
-Range("C101").Clear
-Range("D101").Clear
-Range("A101").Value = "xlAreaStacked"
-Range("B101").Value = 76
-Range("C101").Value = num
-B101 = Range("B101").Value
-C101 = Range("C101").Value
-If B101 = C101 Then
-Range("D101").Value = "OK"
-Else
-Range("D101").Value = "NG"
-End If
-End Function
-
-Function test_xlAreaStacked100(ByRef num)
-Range("A102").Clear
-Range("B102").Clear
-Range("C102").Clear
-Range("D102").Clear
-Range("A102").Value = "xlAreaStacked100"
-Range("B102").Value = 77
-Range("C102").Value = num
-B102 = Range("B102").Value
-C102 = Range("C102").Value
-If B102 = C102 Then
-Range("D102").Value = "OK"
-Else
-Range("D102").Value = "NG"
-End If
-End Function
-
-Function test_xlBarClustered(ByRef num)
-Range("A103").Clear
-Range("B103").Clear
-Range("C103").Clear
-Range("D103").Clear
-Range("A103").Value = "xlBarClustered"
-Range("B103").Value = 57
-Range("C103").Value = num
-B103 = Range("B103").Value
-C103 = Range("C103").Value
-If B103 = C103 Then
-Range("D103").Value = "OK"
-Else
-Range("D103").Value = "NG"
-End If
-End Function
-
-Function test_xlBarOfPie(ByRef num)
-Range("A104").Clear
-Range("B104").Clear
-Range("C104").Clear
-Range("D104").Clear
-Range("A104").Value = "xlBarOfPie"
-Range("B104").Value = 71
-Range("C104").Value = num
-B104 = Range("B104").Value
-C104 = Range("C104").Value
-If B104 = C104 Then
-Range("D104").Value = "OK"
-Else
-Range("D104").Value = "NG"
-End If
-End Function
-
-Function test_xlBarStacked(ByRef num)
-Range("A105").Clear
-Range("B105").Clear
-Range("C105").Clear
-Range("D105").Clear
-Range("A105").Value = "xlBarStacked"
-Range("B105").Value = 58
-Range("C105").Value = num
-B105 = Range("B105").Value
-C105 = Range("C105").Value
-If B105 = C105 Then
-Range("D105").Value = "OK"
-Else
-Range("D105").Value = "NG"
-End If
-End Function
-
-Function test_xlBarStacked100(ByRef num)
-Range("A106").Clear
-Range("B106").Clear
-Range("C106").Clear
-Range("D106").Clear
-Range("A106").Value = "xlBarStacked100"
-Range("B106").Value = 59
-Range("C106").Value = num
-B106 = Range("B106").Value
-C106 = Range("C106").Value
-If B106 = C106 Then
-Range("D106").Value = "OK"
-Else
-Range("D106").Value = "NG"
-End If
-End Function
-
-Function test_xlBubble(ByRef num)
-Range("A107").Clear
-Range("B107").Clear
-Range("C107").Clear
-Range("D107").Clear
-Range("A107").Value = "xlBubble"
-Range("B107").Value = 15
-Range("C107").Value = num
-B107 = Range("B107").Value
-C107 = Range("C107").Value
-If B107 = C107 Then
-Range("D107").Value = "OK"
-Else
-Range("D107").Value = "NG"
-End If
-End Function
-
-Function test_xlBubble3DEffect(ByRef num)
-Range("A108").Clear
-Range("B108").Clear
-Range("C108").Clear
-Range("D108").Clear
-Range("A108").Value = "xlBubble3DEffect"
-Range("B108").Value = 87
-Range("C108").Value = num
-B108 = Range("B108").Value
-C108 = Range("C108").Value
-If B108 = C108 Then
-Range("D108").Value = "OK"
-Else
-Range("D108").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnClustered(ByRef num)
-Range("A109").Clear
-Range("B109").Clear
-Range("C109").Clear
-Range("D109").Clear
-Range("A109").Value = "xlColumnClustered"
-Range("B109").Value = 51
-Range("C109").Value = num
-B109 = Range("B109").Value
-C109 = Range("C109").Value
-If B109 = C109 Then
-Range("D109").Value = "OK"
-Else
-Range("D109").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnStacked(ByRef num)
-Range("A110").Clear
-Range("B110").Clear
-Range("C110").Clear
-Range("D110").Clear
-Range("A110").Value = "xlColumnStacked"
-Range("B110").Value = 52
-Range("C110").Value = num
-B110 = Range("B110").Value
-C110 = Range("C110").Value
-If B110 = C110 Then
-Range("D110").Value = "OK"
-Else
-Range("D110").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnStacked100(ByRef num)
-Range("A111").Clear
-Range("B111").Clear
-Range("C111").Clear
-Range("D111").Clear
-Range("A111").Value = "xlColumnStacked100"
-Range("B111").Value = 53
-Range("C111").Value = num
-B111 = Range("B111").Value
-C111 = Range("C111").Value
-If B111 = C111 Then
-Range("D111").Value = "OK"
-Else
-Range("D111").Value = "NG"
-End If
-End Function
-
-Function test_xlConeBarClustered(ByRef num)
-Range("A112").Clear
-Range("B112").Clear
-Range("C112").Clear
-Range("D112").Clear
-Range("A112").Value = "xlConeBarClustered"
-Range("B112").Value = 102
-Range("C112").Value = num
-B112 = Range("B112").Value
-C112 = Range("C112").Value
-If B112 = C112 Then
-Range("D112").Value = "OK"
-Else
-Range("D112").Value = "NG"
-End If
-End Function
-
-Function test_xlConeBarStacked(ByRef num)
-Range("A113").Clear
-Range("B113").Clear
-Range("C113").Clear
-Range("D113").Clear
-Range("A113").Value = "xlConeBarStacked"
-Range("B113").Value = 103
-Range("C113").Value = num
-B113 = Range("B113").Value
-C113 = Range("C113").Value
-If B113 = C113 Then
-Range("D113").Value = "OK"
-Else
-Range("D113").Value = "NG"
-End If
-End Function
-
-Function test_xlConeBarStacked100(ByRef num)
-Range("A114").Clear
-Range("B114").Clear
-Range("C114").Clear
-Range("D114").Clear
-Range("A114").Value = "xlConeBarStacked100"
-Range("B114").Value = 104
-Range("C114").Value = num
-B114 = Range("B114").Value
-C114 = Range("C114").Value
-If B114 = C114 Then
-Range("D114").Value = "OK"
-Else
-Range("D114").Value = "NG"
-End If
-End Function
-
-Function test_xlConeCol(ByRef num)
-Range("A115").Clear
-Range("B115").Clear
-Range("C115").Clear
-Range("D115").Clear
-Range("A115").Value = "xlConeCol"
-Range("B115").Value = 105
-Range("C115").Value = num
-B115 = Range("B115").Value
-C115 = Range("C115").Value
-If B115 = C115 Then
-Range("D115").Value = "OK"
-Else
-Range("D115").Value = "NG"
-End If
-End Function
-
-Function test_xlConeColClustered(ByRef num)
-Range("A116").Clear
-Range("B116").Clear
-Range("C116").Clear
-Range("D116").Clear
-Range("A116").Value = "xlConeColClustered"
-Range("B116").Value = 99
-Range("C116").Value = num
-B116 = Range("B116").Value
-C116 = Range("C116").Value
-If B116 = C116 Then
-Range("D116").Value = "OK"
-Else
-Range("D116").Value = "NG"
-End If
-End Function
-
-Function test_xlConeColStacked(ByRef num)
-Range("A117").Clear
-Range("B117").Clear
-Range("C117").Clear
-Range("D117").Clear
-Range("A117").Value = "xlConeColStacked"
-Range("B117").Value = 100
-Range("C117").Value = num
-B117 = Range("B117").Value
-C117 = Range("C117").Value
-If B117 = C117 Then
-Range("D117").Value = "OK"
-Else
-Range("D117").Value = "NG"
-End If
-End Function
-
-Function test_xlConeColStacked100(ByRef num)
-Range("A118").Clear
-Range("B118").Clear
-Range("C118").Clear
-Range("D118").Clear
-Range("A118").Value = "xlConeColStacked100"
-Range("B118").Value = 101
-Range("C118").Value = num
-B118 = Range("B118").Value
-C118 = Range("C118").Value
-If B118 = C118 Then
-Range("D118").Value = "OK"
-Else
-Range("D118").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderBarClustered(ByRef num)
-Range("A119").Clear
-Range("B119").Clear
-Range("C119").Clear
-Range("D119").Clear
-Range("A119").Value = "xlCylinderBarClustered"
-Range("B119").Value = 95
-Range("C119").Value = num
-B119 = Range("B119").Value
-C119 = Range("C119").Value
-If B119 = C119 Then
-Range("D119").Value = "OK"
-Else
-Range("D119").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderBarStacked(ByRef num)
-Range("A120").Clear
-Range("B120").Clear
-Range("C120").Clear
-Range("D120").Clear
-Range("A120").Value = "xlCylinderBarStacked"
-Range("B120").Value = 96
-Range("C120").Value = num
-B120 = Range("B120").Value
-C120 = Range("C120").Value
-If B120 = C120 Then
-Range("D120").Value = "OK"
-Else
-Range("D120").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderBarStacked100(ByRef num)
-Range("A121").Clear
-Range("B121").Clear
-Range("C121").Clear
-Range("D121").Clear
-Range("A121").Value = "xlCylinderBarStacked100"
-Range("B121").Value = 97
-Range("C121").Value = num
-B121 = Range("B121").Value
-C121 = Range("C121").Value
-If B121 = C121 Then
-Range("D121").Value = "OK"
-Else
-Range("D121").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderCol(ByRef num)
-Range("A122").Clear
-Range("B122").Clear
-Range("C122").Clear
-Range("D122").Clear
-Range("A122").Value = "xlCylinderCol"
-Range("B122").Value = 98
-Range("C122").Value = num
-B122 = Range("B122").Value
-C122 = Range("C122").Value
-If B122 = C122 Then
-Range("D122").Value = "OK"
-Else
-Range("D122").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderColClustered(ByRef num)
-Range("A123").Clear
-Range("B123").Clear
-Range("C123").Clear
-Range("D123").Clear
-Range("A123").Value = "xlCylinderColClustered"
-Range("B123").Value = 92
-Range("C123").Value = num
-B123 = Range("B123").Value
-C123 = Range("C123").Value
-If B123 = C123 Then
-Range("D123").Value = "OK"
-Else
-Range("D123").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderColStacked(ByRef num)
-Range("A124").Clear
-Range("B124").Clear
-Range("C124").Clear
-Range("D124").Clear
-Range("A124").Value = "xlCylinderColStacked"
-Range("B124").Value = 93
-Range("C124").Value = num
-B124 = Range("B124").Value
-C124 = Range("C124").Value
-If B124 = C124 Then
-Range("D124").Value = "OK"
-Else
-Range("D124").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderColStacked100(ByRef num)
-Range("A125").Clear
-Range("B125").Clear
-Range("C125").Clear
-Range("D125").Clear
-Range("A125").Value = "xlCylinderColStacked100"
-Range("B125").Value = 94
-Range("C125").Value = num
-B125 = Range("B125").Value
-C125 = Range("C125").Value
-If B125 = C125 Then
-Range("D125").Value = "OK"
-Else
-Range("D125").Value = "NG"
-End If
-End Function
-
-Function test_xlDoughnut(ByRef num)
-Range("A126").Clear
-Range("B126").Clear
-Range("C126").Clear
-Range("D126").Clear
-Range("A126").Value = "xlDoughnut"
-Range("B126").Value = -4120
-Range("C126").Value = num
-B126 = Range("B126").Value
-C126 = Range("C126").Value
-If B126 = C126 Then
-Range("D126").Value = "OK"
-Else
-Range("D126").Value = "NG"
-End If
-End Function
-
-Function test_xlDoughnutExploded(ByRef num)
-Range("A127").Clear
-Range("B127").Clear
-Range("C127").Clear
-Range("D127").Clear
-Range("A127").Value = "xlDoughnutExploded"
-Range("B127").Value = 80
-Range("C127").Value = num
-B127 = Range("B127").Value
-C127 = Range("C127").Value
-If B127 = C127 Then
-Range("D127").Value = "OK"
-Else
-Range("D127").Value = "NG"
-End If
-End Function
-
-Function test_xlLine(ByRef num)
-Range("A128").Clear
-Range("B128").Clear
-Range("C128").Clear
-Range("D128").Clear
-Range("A128").Value = "xlLine"
-Range("B128").Value = 4
-Range("C128").Value = num
-B128 = Range("B128").Value
-C128 = Range("C128").Value
-If B128 = C128 Then
-Range("D128").Value = "OK"
-Else
-Range("D128").Value = "NG"
-End If
-End Function
-
-Function test_xlLineMarkers(ByRef num)
-Range("A129").Clear
-Range("B129").Clear
-Range("C129").Clear
-Range("D129").Clear
-Range("A129").Value = "xlLineMarkers"
-Range("B129").Value = 65
-Range("C129").Value = num
-B129 = Range("B129").Value
-C129 = Range("C129").Value
-If B129 = C129 Then
-Range("D129").Value = "OK"
-Else
-Range("D129").Value = "NG"
-End If
-End Function
-
-Function test_xlLineMarkersStacked(ByRef num)
-Range("A130").Clear
-Range("B130").Clear
-Range("C130").Clear
-Range("D130").Clear
-Range("A130").Value = "xlLineMarkersStacked"
-Range("B130").Value = 66
-Range("C130").Value = num
-B130 = Range("B130").Value
-C130 = Range("C130").Value
-If B130 = C130 Then
-Range("D130").Value = "OK"
-Else
-Range("D130").Value = "NG"
-End If
-End Function
-
-Function test_xlLineMarkersStacked100(ByRef num)
-Range("A131").Clear
-Range("B131").Clear
-Range("C131").Clear
-Range("D131").Clear
-Range("A131").Value = "xlLineMarkersStacked100"
-Range("B131").Value = 67
-Range("C131").Value = num
-B131 = Range("B131").Value
-C131 = Range("C131").Value
-If B131 = C131 Then
-Range("D131").Value = "OK"
-Else
-Range("D131").Value = "NG"
-End If
-End Function
-
-Function test_xlLineStacked(ByRef num)
-Range("A132").Clear
-Range("B132").Clear
-Range("C132").Clear
-Range("D132").Clear
-Range("A132").Value = "xlLineStacked"
-Range("B132").Value = 63
-Range("C132").Value = num
-B132 = Range("B132").Value
-C132 = Range("C132").Value
-If B132 = C132 Then
-Range("D132").Value = "OK"
-Else
-Range("D132").Value = "NG"
-End If
-End Function
-
-Function test_xlLineStacked100(ByRef num)
-Range("A133").Clear
-Range("B133").Clear
-Range("C133").Clear
-Range("D133").Clear
-Range("A133").Value = "xlLineStacked100"
-Range("B133").Value = 64
-Range("C133").Value = num
-B133 = Range("B133").Value
-C133 = Range("C133").Value
-If B133 = C133 Then
-Range("D133").Value = "OK"
-Else
-Range("D133").Value = "NG"
-End If
-End Function
-
-Function test_xlPie(ByRef num)
-Range("A134").Clear
-Range("B134").Clear
-Range("C134").Clear
-Range("D134").Clear
-Range("A134").Value = "xlPie"
-Range("B134").Value = 5
-Range("C134").Value = num
-B134 = Range("B134").Value
-C134 = Range("C134").Value
-If B134 = C134 Then
-Range("D134").Value = "OK"
-Else
-Range("D134").Value = "NG"
-End If
-End Function
-
-Function test_xlPieExploded(ByRef num)
-Range("A135").Clear
-Range("B135").Clear
-Range("C135").Clear
-Range("D135").Clear
-Range("A135").Value = "xlPieExploded"
-Range("B135").Value = 69
-Range("C135").Value = num
-B135 = Range("B135").Value
-C135 = Range("C135").Value
-If B135 = C135 Then
-Range("D135").Value = "OK"
-Else
-Range("D135").Value = "NG"
-End If
-End Function
-
-Function test_xlPieOfPie(ByRef num)
-Range("A136").Clear
-Range("B136").Clear
-Range("C136").Clear
-Range("D136").Clear
-Range("A136").Value = "xlPieOfPie"
-Range("B136").Value = 68
-Range("C136").Value = num
-B136 = Range("B136").Value
-C136 = Range("C136").Value
-If B136 = C136 Then
-Range("D136").Value = "OK"
-Else
-Range("D136").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidBarClustered(ByRef num)
-Range("A137").Clear
-Range("B137").Clear
-Range("C137").Clear
-Range("D137").Clear
-Range("A137").Value = "xlPyramidBarClustered"
-Range("B137").Value = 109
-Range("C137").Value = num
-B137 = Range("B137").Value
-C137 = Range("C137").Value
-If B137 = C137 Then
-Range("D137").Value = "OK"
-Else
-Range("D137").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidBarStacked(ByRef num)
-Range("A138").Clear
-Range("B138").Clear
-Range("C138").Clear
-Range("D138").Clear
-Range("A138").Value = "xlPyramidBarStacked"
-Range("B138").Value = 110
-Range("C138").Value = num
-B138 = Range("B138").Value
-C138 = Range("C138").Value
-If B138 = C138 Then
-Range("D138").Value = "OK"
-Else
-Range("D138").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidBarStacked100(ByRef num)
-Range("A139").Clear
-Range("B139").Clear
-Range("C139").Clear
-Range("D139").Clear
-Range("A139").Value = "xlPyramidBarStacked100"
-Range("B139").Value = 111
-Range("C139").Value = num
-B139 = Range("B139").Value
-C139 = Range("C139").Value
-If B139 = C139 Then
-Range("D139").Value = "OK"
-Else
-Range("D139").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidCol(ByRef num)
-Range("A140").Clear
-Range("B140").Clear
-Range("C140").Clear
-Range("D140").Clear
-Range("A140").Value = "xlPyramidCol"
-Range("B140").Value = 112
-Range("C140").Value = num
-B140 = Range("B140").Value
-C140 = Range("C140").Value
-If B140 = C140 Then
-Range("D140").Value = "OK"
-Else
-Range("D140").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidColClustered(ByRef num)
-Range("A141").Clear
-Range("B141").Clear
-Range("C141").Clear
-Range("D141").Clear
-Range("A141").Value = "xlPyramidColClustered"
-Range("B141").Value = 106
-Range("C141").Value = num
-B141 = Range("B141").Value
-C141 = Range("C141").Value
-If B141 = C141 Then
-Range("D141").Value = "OK"
-Else
-Range("D141").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidColStacked(ByRef num)
-Range("A142").Clear
-Range("B142").Clear
-Range("C142").Clear
-Range("D142").Clear
-Range("A142").Value = "xlPyramidColStacked"
-Range("B142").Value = 107
-Range("C142").Value = num
-B142 = Range("B142").Value
-C142 = Range("C142").Value
-If B142 = C142 Then
-Range("D142").Value = "OK"
-Else
-Range("D142").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidColStacked100(ByRef num)
-Range("A143").Clear
-Range("B143").Clear
-Range("C143").Clear
-Range("D143").Clear
-Range("A143").Value = "xlPyramidColStacked100"
-Range("B143").Value = 108
-Range("C143").Value = num
-B143 = Range("B143").Value
-C143 = Range("C143").Value
-If B143 = C143 Then
-Range("D143").Value = "OK"
-Else
-Range("D143").Value = "NG"
-End If
-End Function
-
-Function test_xlRader(ByRef num)
-Range("A144").Clear
-Range("B144").Clear
-Range("C144").Clear
-Range("D144").Clear
-Range("A144").Value = "xlRader"
-Range("B144").Value = -4151
-Range("C144").Value = num
-B144 = Range("B144").Value
-C144 = Range("C144").Value
-If B144 = C144 Then
-Range("D144").Value = "OK"
-Else
-Range("D144").Value = "NG"
-End If
-End Function
-
-Function test_xlRaderFilled(ByRef num)
-Range("A145").Clear
-Range("B145").Clear
-Range("C145").Clear
-Range("D145").Clear
-Range("A145").Value = "xlRaderFilled"
-Range("B145").Value = 82
-Range("C145").Value = num
-B145 = Range("B145").Value
-C145 = Range("C145").Value
-If B145 = C145 Then
-Range("D145").Value = "OK"
-Else
-Range("D145").Value = "NG"
-End If
-End Function
-
-Function test_xlRaderMarkers(ByRef num)
-Range("A146").Clear
-Range("B146").Clear
-Range("C146").Clear
-Range("D146").Clear
-Range("A146").Value = "xlRaderMarkers"
-Range("B146").Value = 81
-Range("C146").Value = num
-B146 = Range("B146").Value
-C146 = Range("C146").Value
-If B146 = C146 Then
-Range("D146").Value = "OK"
-Else
-Range("D146").Value = "NG"
-End If
-End Function
-
-Function test_xlStockHLC(ByRef num)
-Range("A147").Clear
-Range("B147").Clear
-Range("C147").Clear
-Range("D147").Clear
-Range("A147").Value = "xlStockHLC"
-Range("B147").Value = 88
-Range("C147").Value = num
-B147 = Range("B147").Value
-C147 = Range("C147").Value
-If B147 = C147 Then
-Range("D147").Value = "OK"
-Else
-Range("D147").Value = "NG"
-End If
-End Function
-
-Function test_xlStockOHLC(ByRef num)
-Range("A148").Clear
-Range("B148").Clear
-Range("C148").Clear
-Range("D148").Clear
-Range("A148").Value = "xlStockOHLC"
-Range("B148").Value = 89
-Range("C148").Value = num
-B148 = Range("B148").Value
-C148 = Range("C148").Value
-If B148 = C148 Then
-Range("D148").Value = "OK"
-Else
-Range("D148").Value = "NG"
-End If
-End Function
-
-Function test_xlStockVHLC(ByRef num)
-Range("A149").Clear
-Range("B149").Clear
-Range("C149").Clear
-Range("D149").Clear
-Range("A149").Value = "xlStockVHLC"
-Range("B149").Value = 90
-Range("C149").Value = num
-B149 = Range("B149").Value
-C149 = Range("C149").Value
-If B149 = C149 Then
-Range("D149").Value = "OK"
-Else
-Range("D149").Value = "NG"
-End If
-End Function
-
-Function test_xlStockVOHLC(ByRef num)
-Range("A150").Clear
-Range("B150").Clear
-Range("C150").Clear
-Range("D150").Clear
-Range("A150").Value = "xlStockVOHLC"
-Range("B150").Value = 91
-Range("C150").Value = num
-B150 = Range("B150").Value
-C150 = Range("C150").Value
-If B150 = C150 Then
-Range("D150").Value = "OK"
-Else
-Range("D150").Value = "NG"
-End If
-End Function
-
-Function test_xlSurface(ByRef num)
-Range("A151").Clear
-Range("B151").Clear
-Range("C151").Clear
-Range("D151").Clear
-Range("A151").Value = "xlSurface"
-Range("B151").Value = 83
-Range("C151").Value = num
-B151 = Range("B151").Value
-C151 = Range("C151").Value
-If B151 = C151 Then
-Range("D151").Value = "OK"
-Else
-Range("D151").Value = "NG"
-End If
-End Function
-
-Function test_xlSurfaceTopView(ByRef num)
-Range("A152").Clear
-Range("B152").Clear
-Range("C152").Clear
-Range("D152").Clear
-Range("A152").Value = "xlSurfaceTopView"
-Range("B152").Value = 85
-Range("C152").Value = num
-B152 = Range("B152").Value
-C152 = Range("C152").Value
-If B152 = C152 Then
-Range("D152").Value = "OK"
-Else
-Range("D152").Value = "NG"
-End If
-End Function
-
-Function test_xlSurfaceTopViewWireframe(ByRef num)
-Range("A153").Clear
-Range("B153").Clear
-Range("C153").Clear
-Range("D153").Clear
-Range("A153").Value = "xlSurfaceTopViewWireframe"
-Range("B153").Value = 86
-Range("C153").Value = num
-B153 = Range("B153").Value
-C153 = Range("C153").Value
-If B153 = C153 Then
-Range("D153").Value = "OK"
-Else
-Range("D153").Value = "NG"
-End If
-End Function
-
-Function test_xlSurfaceWireframe(ByRef num)
-Range("A154").Clear
-Range("B154").Clear
-Range("C154").Clear
-Range("D154").Clear
-Range("A154").Value = "xlSurfaceWireframe"
-Range("B154").Value = 84
-Range("C154").Value = num
-B154 = Range("B154").Value
-C154 = Range("C154").Value
-If B154 = C154 Then
-Range("D154").Value = "OK"
-Else
-Range("D154").Value = "NG"
-End If
-End Function
-
-Function test_xlXYScatter(ByRef num)
-Range("A155").Clear
-Range("B155").Clear
-Range("C155").Clear
-Range("D155").Clear
-Range("A155").Value = "xlXYScatter"
-Range("B155").Value = -4169
-Range("C155").Value = num
-B155 = Range("B155").Value
-C155 = Range("C155").Value
-If B155 = C155 Then
-Range("D155").Value = "OK"
-Else
-Range("D155").Value = "NG"
-End If
-End Function
-
-Function test_xlXYScatterLines(ByRef num)
-Range("A156").Clear
-Range("B156").Clear
-Range("C156").Clear
-Range("D156").Clear
-Range("A156").Value = "xlXYScatterLines"
-Range("B156").Value = 74
-Range("C156").Value = num
-B156 = Range("B156").Value
-C156 = Range("C156").Value
-If B156 = C156 Then
-Range("D156").Value = "OK"
-Else
-Range("D156").Value = "NG"
-End If
-End Function
-
-Function test_xlXYScatterLinesNoMarkers(ByRef num)
-Range("A157").Clear
-Range("B157").Clear
-Range("C157").Clear
-Range("D157").Clear
-Range("A157").Value = "xlXYScatterLinesNoMarkers"
-Range("B157").Value = 75
-Range("C157").Value = num
-B157 = Range("B157").Value
-C157 = Range("C157").Value
-If B157 = C157 Then
-Range("D157").Value = "OK"
-Else
-Range("D157").Value = "NG"
-End If
-End Function
-
-Function test_xlXYScatterSmooth(ByRef num)
-Range("A158").Clear
-Range("B158").Clear
-Range("C158").Clear
-Range("D158").Clear
-Range("A158").Value = "xlXYScatterSmooth"
-Range("B158").Value = 72
-Range("C158").Value = num
-B158 = Range("B158").Value
-C158 = Range("C158").Value
-If B158 = C158 Then
-Range("D158").Value = "OK"
-Else
-Range("D158").Value = "NG"
-End If
-End Function
-
-Function test_xlXYScatterSmoothNoMarkers(ByRef num)
-Range("A159").Clear
-Range("B159").Clear
-Range("C159").Clear
-Range("D159").Clear
-Range("A159").Value = "xlXYScatterSmoothNoMarkers"
-Range("B159").Value = 73
-Range("C159").Value = num
-B159 = Range("B159").Value
-C159 = Range("C159").Value
-If B159 = C159 Then
-Range("D159").Value = "OK"
-Else
-Range("D159").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBIFF(ByRef num)
-Range("A160").Clear
-Range("B160").Clear
-Range("C160").Clear
-Range("D160").Clear
-Range("A160").Value = "xlClipboardFormatBIFF"
-Range("B160").Value = 8
-Range("C160").Value = num
-B160 = Range("B160").Value
-C160 = Range("C160").Value
-If B160 = C160 Then
-Range("D160").Value = "OK"
-Else
-Range("D160").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBIFF2(ByRef num)
-Range("A161").Clear
-Range("B161").Clear
-Range("C161").Clear
-Range("D161").Clear
-Range("A161").Value = "xlClipboardFormatBIFF2"
-Range("B161").Value = 18
-Range("C161").Value = num
-B161 = Range("B161").Value
-C161 = Range("C161").Value
-If B161 = C161 Then
-Range("D161").Value = "OK"
-Else
-Range("D161").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBIFF3(ByRef num)
-Range("A162").Clear
-Range("B162").Clear
-Range("C162").Clear
-Range("D162").Clear
-Range("A162").Value = "xlClipboardFormatBIFF3"
-Range("B162").Value = 20
-Range("C162").Value = num
-B162 = Range("B162").Value
-C162 = Range("C162").Value
-If B162 = C162 Then
-Range("D162").Value = "OK"
-Else
-Range("D162").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBIFF4(ByRef num)
-Range("A163").Clear
-Range("B163").Clear
-Range("C163").Clear
-Range("D163").Clear
-Range("A163").Value = "xlClipboardFormatBIFF4"
-Range("B163").Value = 30
-Range("C163").Value = num
-B163 = Range("B163").Value
-C163 = Range("C163").Value
-If B163 = C163 Then
-Range("D163").Value = "OK"
-Else
-Range("D163").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBinary(ByRef num)
-Range("A164").Clear
-Range("B164").Clear
-Range("C164").Clear
-Range("D164").Clear
-Range("A164").Value = "xlClipboardFormatBinary"
-Range("B164").Value = 15
-Range("C164").Value = num
-B164 = Range("B164").Value
-C164 = Range("C164").Value
-If B164 = C164 Then
-Range("D164").Value = "OK"
-Else
-Range("D164").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBitmap(ByRef num)
-Range("A165").Clear
-Range("B165").Clear
-Range("C165").Clear
-Range("D165").Clear
-Range("A165").Value = "xlClipboardFormatBitmap"
-Range("B165").Value = 9
-Range("C165").Value = num
-B165 = Range("B165").Value
-C165 = Range("C165").Value
-If B165 = C165 Then
-Range("D165").Value = "OK"
-Else
-Range("D165").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatCGM(ByRef num)
-Range("A166").Clear
-Range("B166").Clear
-Range("C166").Clear
-Range("D166").Clear
-Range("A166").Value = "xlClipboardFormatCGM"
-Range("B166").Value = 13
-Range("C166").Value = num
-B166 = Range("B166").Value
-C166 = Range("C166").Value
-If B166 = C166 Then
-Range("D166").Value = "OK"
-Else
-Range("D166").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatCSV(ByRef num)
-Range("A167").Clear
-Range("B167").Clear
-Range("C167").Clear
-Range("D167").Clear
-Range("A167").Value = "xlClipboardFormatCSV"
-Range("B167").Value = 5
-Range("C167").Value = num
-B167 = Range("B167").Value
-C167 = Range("C167").Value
-If B167 = C167 Then
-Range("D167").Value = "OK"
-Else
-Range("D167").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatDIF(ByRef num)
-Range("A168").Clear
-Range("B168").Clear
-Range("C168").Clear
-Range("D168").Clear
-Range("A168").Value = "xlClipboardFormatDIF"
-Range("B168").Value = 4
-Range("C168").Value = num
-B168 = Range("B168").Value
-C168 = Range("C168").Value
-If B168 = C168 Then
-Range("D168").Value = "OK"
-Else
-Range("D168").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatDspText(ByRef num)
-Range("A169").Clear
-Range("B169").Clear
-Range("C169").Clear
-Range("D169").Clear
-Range("A169").Value = "xlClipboardFormatDspText"
-Range("B169").Value = 12
-Range("C169").Value = num
-B169 = Range("B169").Value
-C169 = Range("C169").Value
-If B169 = C169 Then
-Range("D169").Value = "OK"
-Else
-Range("D169").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatEmbeddedObject(ByRef num)
-Range("A170").Clear
-Range("B170").Clear
-Range("C170").Clear
-Range("D170").Clear
-Range("A170").Value = "xlClipboardFormatEmbeddedObject"
-Range("B170").Value = 21
-Range("C170").Value = num
-B170 = Range("B170").Value
-C170 = Range("C170").Value
-If B170 = C170 Then
-Range("D170").Value = "OK"
-Else
-Range("D170").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatEmbedSource(ByRef num)
-Range("A171").Clear
-Range("B171").Clear
-Range("C171").Clear
-Range("D171").Clear
-Range("A171").Value = "xlClipboardFormatEmbedSource"
-Range("B171").Value = 22
-Range("C171").Value = num
-B171 = Range("B171").Value
-C171 = Range("C171").Value
-If B171 = C171 Then
-Range("D171").Value = "OK"
-Else
-Range("D171").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatLink(ByRef num)
-Range("A172").Clear
-Range("B172").Clear
-Range("C172").Clear
-Range("D172").Clear
-Range("A172").Value = "xlClipboardFormatLink"
-Range("B172").Value = 11
-Range("C172").Value = num
-B172 = Range("B172").Value
-C172 = Range("C172").Value
-If B172 = C172 Then
-Range("D172").Value = "OK"
-Else
-Range("D172").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatLinkSource(ByRef num)
-Range("A173").Clear
-Range("B173").Clear
-Range("C173").Clear
-Range("D173").Clear
-Range("A173").Value = "xlClipboardFormatLinkSource"
-Range("B173").Value = 23
-Range("C173").Value = num
-B173 = Range("B173").Value
-C173 = Range("C173").Value
-If B173 = C173 Then
-Range("D173").Value = "OK"
-Else
-Range("D173").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatLinkSourceDesc(ByRef num)
-Range("A174").Clear
-Range("B174").Clear
-Range("C174").Clear
-Range("D174").Clear
-Range("A174").Value = "xlClipboardFormatLinkSourceDesc"
-Range("B174").Value = 32
-Range("C174").Value = num
-B174 = Range("B174").Value
-C174 = Range("C174").Value
-If B174 = C174 Then
-Range("D174").Value = "OK"
-Else
-Range("D174").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatMovie(ByRef num)
-Range("A175").Clear
-Range("B175").Clear
-Range("C175").Clear
-Range("D175").Clear
-Range("A175").Value = "xlClipboardFormatMovie"
-Range("B175").Value = 24
-Range("C175").Value = num
-B175 = Range("B175").Value
-C175 = Range("C175").Value
-If B175 = C175 Then
-Range("D175").Value = "OK"
-Else
-Range("D175").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatNative(ByRef num)
-Range("A176").Clear
-Range("B176").Clear
-Range("C176").Clear
-Range("D176").Clear
-Range("A176").Value = "xlClipboardFormatNative"
-Range("B176").Value = 14
-Range("C176").Value = num
-B176 = Range("B176").Value
-C176 = Range("C176").Value
-If B176 = C176 Then
-Range("D176").Value = "OK"
-Else
-Range("D176").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatObjectDesc(ByRef num)
-Range("A177").Clear
-Range("B177").Clear
-Range("C177").Clear
-Range("D177").Clear
-Range("A177").Value = "xlClipboardFormatObjectDesc"
-Range("B177").Value = 31
-Range("C177").Value = num
-B177 = Range("B177").Value
-C177 = Range("C177").Value
-If B177 = C177 Then
-Range("D177").Value = "OK"
-Else
-Range("D177").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatObjectLink(ByRef num)
-Range("A178").Clear
-Range("B178").Clear
-Range("C178").Clear
-Range("D178").Clear
-Range("A178").Value = "xlClipboardFormatObjectLink"
-Range("B178").Value = 19
-Range("C178").Value = num
-B178 = Range("B178").Value
-C178 = Range("C178").Value
-If B178 = C178 Then
-Range("D178").Value = "OK"
-Else
-Range("D178").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatOwnerLink(ByRef num)
-Range("A179").Clear
-Range("B179").Clear
-Range("C179").Clear
-Range("D179").Clear
-Range("A179").Value = "xlClipboardFormatOwnerLink"
-Range("B179").Value = 17
-Range("C179").Value = num
-B179 = Range("B179").Value
-C179 = Range("C179").Value
-If B179 = C179 Then
-Range("D179").Value = "OK"
-Else
-Range("D179").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatPICT(ByRef num)
-Range("A180").Clear
-Range("B180").Clear
-Range("C180").Clear
-Range("D180").Clear
-Range("A180").Value = "xlClipboardFormatPICT"
-Range("B180").Value = 2
-Range("C180").Value = num
-B180 = Range("B180").Value
-C180 = Range("C180").Value
-If B180 = C180 Then
-Range("D180").Value = "OK"
-Else
-Range("D180").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatPrintPICT(ByRef num)
-Range("A181").Clear
-Range("B181").Clear
-Range("C181").Clear
-Range("D181").Clear
-Range("A181").Value = "xlClipboardFormatPrintPICT"
-Range("B181").Value = 3
-Range("C181").Value = num
-B181 = Range("B181").Value
-C181 = Range("C181").Value
-If B181 = C181 Then
-Range("D181").Value = "OK"
-Else
-Range("D181").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatRTF(ByRef num)
-Range("A182").Clear
-Range("B182").Clear
-Range("C182").Clear
-Range("D182").Clear
-Range("A182").Value = "xlClipboardFormatRTF"
-Range("B182").Value = 7
-Range("C182").Value = num
-B182 = Range("B182").Value
-C182 = Range("C182").Value
-If B182 = C182 Then
-Range("D182").Value = "OK"
-Else
-Range("D182").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatScreenPICT(ByRef num)
-Range("A183").Clear
-Range("B183").Clear
-Range("C183").Clear
-Range("D183").Clear
-Range("A183").Value = "xlClipboardFormatScreenPICT"
-Range("B183").Value = 29
-Range("C183").Value = num
-B183 = Range("B183").Value
-C183 = Range("C183").Value
-If B183 = C183 Then
-Range("D183").Value = "OK"
-Else
-Range("D183").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatStandardFont(ByRef num)
-Range("A184").Clear
-Range("B184").Clear
-Range("C184").Clear
-Range("D184").Clear
-Range("A184").Value = "xlClipboardFormatStandardFont"
-Range("B184").Value = 28
-Range("C184").Value = num
-B184 = Range("B184").Value
-C184 = Range("C184").Value
-If B184 = C184 Then
-Range("D184").Value = "OK"
-Else
-Range("D184").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatStandardScale(ByRef num)
-Range("A185").Clear
-Range("B185").Clear
-Range("C185").Clear
-Range("D185").Clear
-Range("A185").Value = "xlClipboardFormatStandardScale"
-Range("B185").Value = 27
-Range("C185").Value = num
-B185 = Range("B185").Value
-C185 = Range("C185").Value
-If B185 = C185 Then
-Range("D185").Value = "OK"
-Else
-Range("D185").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatSYLK(ByRef num)
-Range("A186").Clear
-Range("B186").Clear
-Range("C186").Clear
-Range("D186").Clear
-Range("A186").Value = "xlClipboardFormatSYLK"
-Range("B186").Value = 6
-Range("C186").Value = num
-B186 = Range("B186").Value
-C186 = Range("C186").Value
-If B186 = C186 Then
-Range("D186").Value = "OK"
-Else
-Range("D186").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatTable(ByRef num)
-Range("A187").Clear
-Range("B187").Clear
-Range("C187").Clear
-Range("D187").Clear
-Range("A187").Value = "xlClipboardFormatTable"
-Range("B187").Value = 16
-Range("C187").Value = num
-B187 = Range("B187").Value
-C187 = Range("C187").Value
-If B187 = C187 Then
-Range("D187").Value = "OK"
-Else
-Range("D187").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatText(ByRef num)
-Range("A188").Clear
-Range("B188").Clear
-Range("C188").Clear
-Range("D188").Clear
-Range("A188").Value = "xlClipboardFormatText"
-Range("B188").Value = 0
-Range("C188").Value = num
-B188 = Range("B188").Value
-C188 = Range("C188").Value
-If B188 = C188 Then
-Range("D188").Value = "OK"
-Else
-Range("D188").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatToolFace(ByRef num)
-Range("A189").Clear
-Range("B189").Clear
-Range("C189").Clear
-Range("D189").Clear
-Range("A189").Value = "xlClipboardFormatToolFace"
-Range("B189").Value = 25
-Range("C189").Value = num
-B189 = Range("B189").Value
-C189 = Range("C189").Value
-If B189 = C189 Then
-Range("D189").Value = "OK"
-Else
-Range("D189").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatToolFacePICT(ByRef num)
-Range("A190").Clear
-Range("B190").Clear
-Range("C190").Clear
-Range("D190").Clear
-Range("A190").Value = "xlClipboardFormatToolFacePICT"
-Range("B190").Value = 26
-Range("C190").Value = num
-B190 = Range("B190").Value
-C190 = Range("C190").Value
-If B190 = C190 Then
-Range("D190").Value = "OK"
-Else
-Range("D190").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatToolVALU(ByRef num)
-Range("A191").Clear
-Range("B191").Clear
-Range("C191").Clear
-Range("D191").Clear
-Range("A191").Value = "xlClipboardFormatToolVALU"
-Range("B191").Value = 1
-Range("C191").Value = num
-B191 = Range("B191").Value
-C191 = Range("C191").Value
-If B191 = C191 Then
-Range("D191").Value = "OK"
-Else
-Range("D191").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatToolWK1(ByRef num)
-Range("A192").Clear
-Range("B192").Clear
-Range("C192").Clear
-Range("D192").Clear
-Range("A192").Value = "xlClipboardFormatToolWK1"
-Range("B192").Value = 10
-Range("C192").Value = num
-B192 = Range("B192").Value
-C192 = Range("C192").Value
-If B192 = C192 Then
-Range("D192").Value = "OK"
-Else
-Range("D192").Value = "NG"
-End If
-End Function
-
-Function test_xlCmdCube(ByRef num)
-Range("A193").Clear
-Range("B193").Clear
-Range("C193").Clear
-Range("D193").Clear
-Range("A193").Value = "xlCmdCube"
-Range("B193").Value = 1
-Range("C193").Value = num
-B193 = Range("B193").Value
-C193 = Range("C193").Value
-If B193 = C193 Then
-Range("D193").Value = "OK"
-Else
-Range("D193").Value = "NG"
-End If
-End Function
-
-Function test_xlCmdDefault(ByRef num)
-Range("A194").Clear
-Range("B194").Clear
-Range("C194").Clear
-Range("D194").Clear
-Range("A194").Value = "xlCmdDefault"
-Range("B194").Value = 4
-Range("C194").Value = num
-B194 = Range("B194").Value
-C194 = Range("C194").Value
-If B194 = C194 Then
-Range("D194").Value = "OK"
-Else
-Range("D194").Value = "NG"
-End If
-End Function
-
-Function test_xlCmdList(ByRef num)
-Range("A195").Clear
-Range("B195").Clear
-Range("C195").Clear
-Range("D195").Clear
-Range("A195").Value = "xlCmdList"
-Range("B195").Value = 5
-Range("C195").Value = num
-B195 = Range("B195").Value
-C195 = Range("C195").Value
-If B195 = C195 Then
-Range("D195").Value = "OK"
-Else
-Range("D195").Value = "NG"
-End If
-End Function
-
-Function test_xlCmdSql(ByRef num)
-Range("A196").Clear
-Range("B196").Clear
-Range("C196").Clear
-Range("D196").Clear
-Range("A196").Value = "xlCmdSql"
-Range("B196").Value = 2
-Range("C196").Value = num
-B196 = Range("B196").Value
-C196 = Range("C196").Value
-If B196 = C196 Then
-Range("D196").Value = "OK"
-Else
-Range("D196").Value = "NG"
-End If
-End Function
-
-Function test_xlCmdTable(ByRef num)
-Range("A197").Clear
-Range("B197").Clear
-Range("C197").Clear
-Range("D197").Clear
-Range("A197").Value = "xlCmdTable"
-Range("B197").Value = 3
-Range("C197").Value = num
-B197 = Range("B197").Value
-C197 = Range("C197").Value
-If B197 = C197 Then
-Range("D197").Value = "OK"
-Else
-Range("D197").Value = "NG"
-End If
-End Function
-
-Function test_xlColorIndexAutomatic(ByRef num)
-Range("A198").Clear
-Range("B198").Clear
-Range("C198").Clear
-Range("D198").Clear
-Range("A198").Value = "xlColorIndexAutomatic"
-Range("B198").Value = -4105
-Range("C198").Value = num
-B198 = Range("B198").Value
-C198 = Range("C198").Value
-If B198 = C198 Then
-Range("D198").Value = "OK"
-Else
-Range("D198").Value = "NG"
-End If
-End Function
-
-Function test_xlColorIndexNone(ByRef num)
-Range("A199").Clear
-Range("B199").Clear
-Range("C199").Clear
-Range("D199").Clear
-Range("A199").Value = "xlColorIndexNone"
-Range("B199").Value = -4142
-Range("C199").Value = num
-B199 = Range("B199").Value
-C199 = Range("C199").Value
-If B199 = C199 Then
-Range("D199").Value = "OK"
-Else
-Range("D199").Value = "NG"
-End If
-End Function
-
-Function test_xlDMYFormat(ByRef num)
-Range("A200").Clear
-Range("B200").Clear
-Range("C200").Clear
-Range("D200").Clear
-Range("A200").Value = "xlDMYFormat"
-Range("B200").Value = 4
-Range("C200").Value = num
-B200 = Range("B200").Value
-C200 = Range("C200").Value
-If B200 = C200 Then
-Range("D200").Value = "OK"
-Else
-Range("D200").Value = "NG"
-End If
-End Function
-
-Function test_xlDYMFormat(ByRef num)
-Range("A201").Clear
-Range("B201").Clear
-Range("C201").Clear
-Range("D201").Clear
-Range("A201").Value = "xlDYMFormat"
-Range("B201").Value = 7
-Range("C201").Value = num
-B201 = Range("B201").Value
-C201 = Range("C201").Value
-If B201 = C201 Then
-Range("D201").Value = "OK"
-Else
-Range("D201").Value = "NG"
-End If
-End Function
-
-Function test_xlEMDFormat(ByRef num)
-Range("A202").Clear
-Range("B202").Clear
-Range("C202").Clear
-Range("D202").Clear
-Range("A202").Value = "xlEMDFormat"
-Range("B202").Value = 10
-Range("C202").Value = num
-B202 = Range("B202").Value
-C202 = Range("C202").Value
-If B202 = C202 Then
-Range("D202").Value = "OK"
-Else
-Range("D202").Value = "NG"
-End If
-End Function
-
-Function test_xlGeneralFormat(ByRef num)
-Range("A203").Clear
-Range("B203").Clear
-Range("C203").Clear
-Range("D203").Clear
-Range("A203").Value = "xlGeneralFormat"
-Range("B203").Value = 1
-Range("C203").Value = num
-B203 = Range("B203").Value
-C203 = Range("C203").Value
-If B203 = C203 Then
-Range("D203").Value = "OK"
-Else
-Range("D203").Value = "NG"
-End If
-End Function
-
-Function test_xlMDYFormat(ByRef num)
-Range("A204").Clear
-Range("B204").Clear
-Range("C204").Clear
-Range("D204").Clear
-Range("A204").Value = "xlMDYFormat"
-Range("B204").Value = 3
-Range("C204").Value = num
-B204 = Range("B204").Value
-C204 = Range("C204").Value
-If B204 = C204 Then
-Range("D204").Value = "OK"
-Else
-Range("D204").Value = "NG"
-End If
-End Function
-
-Function test_xlMYDFormat(ByRef num)
-Range("A205").Clear
-Range("B205").Clear
-Range("C205").Clear
-Range("D205").Clear
-Range("A205").Value = "xlMYDFormat"
-Range("B205").Value = 6
-Range("C205").Value = num
-B205 = Range("B205").Value
-C205 = Range("C205").Value
-If B205 = C205 Then
-Range("D205").Value = "OK"
-Else
-Range("D205").Value = "NG"
-End If
-End Function
-
-Function test_xlSkipColumn(ByRef num)
-Range("A206").Clear
-Range("B206").Clear
-Range("C206").Clear
-Range("D206").Clear
-Range("A206").Value = "xlSkipColumn"
-Range("B206").Value = 9
-Range("C206").Value = num
-B206 = Range("B206").Value
-C206 = Range("C206").Value
-If B206 = C206 Then
-Range("D206").Value = "OK"
-Else
-Range("D206").Value = "NG"
-End If
-End Function
-
-Function test_xlTextFormat(ByRef num)
-Range("A207").Clear
-Range("B207").Clear
-Range("C207").Clear
-Range("D207").Clear
-Range("A207").Value = "xlTextFormat"
-Range("B207").Value = 2
-Range("C207").Value = num
-B207 = Range("B207").Value
-C207 = Range("C207").Value
-If B207 = C207 Then
-Range("D207").Value = "OK"
-Else
-Range("D207").Value = "NG"
-End If
-End Function
-
-Function test_xlYDMFormat(ByRef num)
-Range("A208").Clear
-Range("B208").Clear
-Range("C208").Clear
-Range("D208").Clear
-Range("A208").Value = "xlYDMFormat"
-Range("B208").Value = 8
-Range("C208").Value = num
-B208 = Range("B208").Value
-C208 = Range("C208").Value
-If B208 = C208 Then
-Range("D208").Value = "OK"
-Else
-Range("D208").Value = "NG"
-End If
-End Function
-
-Function test_xlYMDFormat(ByRef num)
-Range("A209").Clear
-Range("B209").Clear
-Range("C209").Clear
-Range("D209").Clear
-Range("A209").Value = "xlYMDFormat"
-Range("B209").Value = 5
-Range("C209").Value = num
-B209 = Range("B209").Value
-C209 = Range("C209").Value
-If B209 = C209 Then
-Range("D209").Value = "OK"
-Else
-Range("D209").Value = "NG"
-End If
-End Function
-
-Function test_xlCommandUnderlinesAutomatic(ByRef num)
-Range("A210").Clear
-Range("B210").Clear
-Range("C210").Clear
-Range("D210").Clear
-Range("A210").Value = "xlCommandUnderlinesAutomatic"
-Range("B210").Value = -4105
-Range("C210").Value = num
-B210 = Range("B210").Value
-C210 = Range("C210").Value
-If B210 = C210 Then
-Range("D210").Value = "OK"
-Else
-Range("D210").Value = "NG"
-End If
-End Function
-
-Function test_xlCommandUnderlinesOff(ByRef num)
-Range("A211").Clear
-Range("B211").Clear
-Range("C211").Clear
-Range("D211").Clear
-Range("A211").Value = "xlCommandUnderlinesOff"
-Range("B211").Value = -4146
-Range("C211").Value = num
-B211 = Range("B211").Value
-C211 = Range("C211").Value
-If B211 = C211 Then
-Range("D211").Value = "OK"
-Else
-Range("D211").Value = "NG"
-End If
-End Function
-
-Function test_xlCommandUnderlinesOn(ByRef num)
-Range("A212").Clear
-Range("B212").Clear
-Range("C212").Clear
-Range("D212").Clear
-Range("A212").Value = "xlCommandUnderlinesOn"
-Range("B212").Value = 1
-Range("C212").Value = num
-B212 = Range("B212").Value
-C212 = Range("C212").Value
-If B212 = C212 Then
-Range("D212").Value = "OK"
-Else
-Range("D212").Value = "NG"
-End If
-End Function
-
-Function test_xlCommentAndIndicator(ByRef num)
-Range("A213").Clear
-Range("B213").Clear
-Range("C213").Clear
-Range("D213").Clear
-Range("A213").Value = "xlCommentAndIndicator"
-Range("B213").Value = 1
-Range("C213").Value = num
-B213 = Range("B213").Value
-C213 = Range("C213").Value
-If B213 = C213 Then
-Range("D213").Value = "OK"
-Else
-Range("D213").Value = "NG"
-End If
-End Function
-
-Function test_xlCommentIndicatorOnly(ByRef num)
-Range("A214").Clear
-Range("B214").Clear
-Range("C214").Clear
-Range("D214").Clear
-Range("A214").Value = "xlCommentIndicatorOnly"
-Range("B214").Value = -1
-Range("C214").Value = num
-B214 = Range("B214").Value
-C214 = Range("C214").Value
-If B214 = C214 Then
-Range("D214").Value = "OK"
-Else
-Range("D214").Value = "NG"
-End If
-End Function
-
-Function test_xlNoIndicator(ByRef num)
-Range("A215").Clear
-Range("B215").Clear
-Range("C215").Clear
-Range("D215").Clear
-Range("A215").Value = "xlNoIndicator"
-Range("B215").Value = 0
-Range("C215").Value = num
-B215 = Range("B215").Value
-C215 = Range("C215").Value
-If B215 = C215 Then
-Range("D215").Value = "OK"
-Else
-Range("D215").Value = "NG"
-End If
-End Function
-
-Function test_xlAverage(ByRef num)
-Range("A216").Clear
-Range("B216").Clear
-Range("C216").Clear
-Range("D216").Clear
-Range("A216").Value = "xlAverage"
-Range("B216").Value = -4106
-Range("C216").Value = num
-B216 = Range("B216").Value
-C216 = Range("C216").Value
-If B216 = C216 Then
-Range("D216").Value = "OK"
-Else
-Range("D216").Value = "NG"
-End If
-End Function
-
-Function test_xlCount(ByRef num)
-Range("A217").Clear
-Range("B217").Clear
-Range("C217").Clear
-Range("D217").Clear
-Range("A217").Value = "xlCount"
-Range("B217").Value = -4112
-Range("C217").Value = num
-B217 = Range("B217").Value
-C217 = Range("C217").Value
-If B217 = C217 Then
-Range("D217").Value = "OK"
-Else
-Range("D217").Value = "NG"
-End If
-End Function
-
-Function test_xlCountNums(ByRef num)
-Range("A218").Clear
-Range("B218").Clear
-Range("C218").Clear
-Range("D218").Clear
-Range("A218").Value = "xlCountNums"
-Range("B218").Value = -4113
-Range("C218").Value = num
-B218 = Range("B218").Value
-C218 = Range("C218").Value
-If B218 = C218 Then
-Range("D218").Value = "OK"
-Else
-Range("D218").Value = "NG"
-End If
-End Function
-
-Function test_xlMax(ByRef num)
-Range("A219").Clear
-Range("B219").Clear
-Range("C219").Clear
-Range("D219").Clear
-Range("A219").Value = "xlMax"
-Range("B219").Value = -4136
-Range("C219").Value = num
-B219 = Range("B219").Value
-C219 = Range("C219").Value
-If B219 = C219 Then
-Range("D219").Value = "OK"
-Else
-Range("D219").Value = "NG"
-End If
-End Function
-
-Function test_xlMin(ByRef num)
-Range("A220").Clear
-Range("B220").Clear
-Range("C220").Clear
-Range("D220").Clear
-Range("A220").Value = "xlMin"
-Range("B220").Value = -4139
-Range("C220").Value = num
-B220 = Range("B220").Value
-C220 = Range("C220").Value
-If B220 = C220 Then
-Range("D220").Value = "OK"
-Else
-Range("D220").Value = "NG"
-End If
-End Function
-
-Function test_xlProduct(ByRef num)
-Range("A221").Clear
-Range("B221").Clear
-Range("C221").Clear
-Range("D221").Clear
-Range("A221").Value = "xlProduct"
-Range("B221").Value = -4149
-Range("C221").Value = num
-B221 = Range("B221").Value
-C221 = Range("C221").Value
-If B221 = C221 Then
-Range("D221").Value = "OK"
-Else
-Range("D221").Value = "NG"
-End If
-End Function
-
-Function test_xlStDev(ByRef num)
-Range("A222").Clear
-Range("B222").Clear
-Range("C222").Clear
-Range("D222").Clear
-Range("A222").Value = "xlStDev"
-Range("B222").Value = -4155
-Range("C222").Value = num
-B222 = Range("B222").Value
-C222 = Range("C222").Value
-If B222 = C222 Then
-Range("D222").Value = "OK"
-Else
-Range("D222").Value = "NG"
-End If
-End Function
-
-Function test_xlStDevP(ByRef num)
-Range("A223").Clear
-Range("B223").Clear
-Range("C223").Clear
-Range("D223").Clear
-Range("A223").Value = "xlStDevP"
-Range("B223").Value = -4156
-Range("C223").Value = num
-B223 = Range("B223").Value
-C223 = Range("C223").Value
-If B223 = C223 Then
-Range("D223").Value = "OK"
-Else
-Range("D223").Value = "NG"
-End If
-End Function
-
-Function test_xlSum(ByRef num)
-Range("A224").Clear
-Range("B224").Clear
-Range("C224").Clear
-Range("D224").Clear
-Range("A224").Value = "xlSum"
-Range("B224").Value = -4157
-Range("C224").Value = num
-B224 = Range("B224").Value
-C224 = Range("C224").Value
-If B224 = C224 Then
-Range("D224").Value = "OK"
-Else
-Range("D224").Value = "NG"
-End If
-End Function
-
-Function test_xlUnknown(ByRef num)
-Range("A225").Clear
-Range("B225").Clear
-Range("C225").Clear
-Range("D225").Clear
-Range("A225").Value = "xlUnknown"
-Range("B225").Value = 1000
-Range("C225").Value = num
-B225 = Range("B225").Value
-C225 = Range("C225").Value
-If B225 = C225 Then
-Range("D225").Value = "OK"
-Else
-Range("D225").Value = "NG"
-End If
-End Function
-
-Function test_xlVar(ByRef num)
-Range("A226").Clear
-Range("B226").Clear
-Range("C226").Clear
-Range("D226").Clear
-Range("A226").Value = "xlVar"
-Range("B226").Value = -4164
-Range("C226").Value = num
-B226 = Range("B226").Value
-C226 = Range("C226").Value
-If B226 = C226 Then
-Range("D226").Value = "OK"
-Else
-Range("D226").Value = "NG"
-End If
-End Function
-
-Function test_xlVarP(ByRef num)
-Range("A227").Clear
-Range("B227").Clear
-Range("C227").Clear
-Range("D227").Clear
-Range("A227").Value = "xlVarP"
-Range("B227").Value = -4165
-Range("C227").Value = num
-B227 = Range("B227").Value
-C227 = Range("C227").Value
-If B227 = C227 Then
-Range("D227").Value = "OK"
-Else
-Range("D227").Value = "NG"
-End If
-End Function
-
-Function test_xlBitmap(ByRef num)
-Range("A228").Clear
-Range("B228").Clear
-Range("C228").Clear
-Range("D228").Clear
-Range("A228").Value = "xlBitmap"
-Range("B228").Value = 2
-Range("C228").Value = num
-B228 = Range("B228").Value
-C228 = Range("C228").Value
-If B228 = C228 Then
-Range("D228").Value = "OK"
-Else
-Range("D228").Value = "NG"
-End If
-End Function
-
-Function test_xlPicture(ByRef num)
-Range("A229").Clear
-Range("B229").Clear
-Range("C229").Clear
-Range("D229").Clear
-Range("A229").Value = "xlPicture"
-Range("B229").Value = -4147
-Range("C229").Value = num
-B229 = Range("B229").Value
-C229 = Range("C229").Value
-If B229 = C229 Then
-Range("D229").Value = "OK"
-Else
-Range("D229").Value = "NG"
-End If
-End Function
-
-Function test_xlExtractData(ByRef num)
-Range("A230").Clear
-Range("B230").Clear
-Range("C230").Clear
-Range("D230").Clear
-Range("A230").Value = "xlExtractData"
-Range("B230").Value = 2
-Range("C230").Value = num
-B230 = Range("B230").Value
-C230 = Range("C230").Value
-If B230 = C230 Then
-Range("D230").Value = "OK"
-Else
-Range("D230").Value = "NG"
-End If
-End Function
-
-Function test_xlNormalLoad(ByRef num)
-Range("A231").Clear
-Range("B231").Clear
-Range("C231").Clear
-Range("D231").Clear
-Range("A231").Value = "xlNormalLoad"
-Range("B231").Value = 0
-Range("C231").Value = num
-B231 = Range("B231").Value
-C231 = Range("C231").Value
-If B231 = C231 Then
-Range("D231").Value = "OK"
-Else
-Range("D231").Value = "NG"
-End If
-End Function
-
-Function test_xlRepairFile(ByRef num)
-Range("A232").Clear
-Range("B232").Clear
-Range("C232").Clear
-Range("D232").Clear
-Range("A232").Value = "xlRepairFile"
-Range("B232").Value = 1
-Range("C232").Value = num
-B232 = Range("B232").Value
-C232 = Range("C232").Value
-If B232 = C232 Then
-Range("D232").Value = "OK"
-Else
-Range("D232").Value = "NG"
-End If
-End Function
-
-Function test_xlCreatorCode(ByRef num)
-Range("A233").Clear
-Range("B233").Clear
-Range("C233").Clear
-Range("D233").Clear
-Range("A233").Value = "xlCreatorCode"
-Range("B233").Value = 1480803660
-Range("C233").Value = num
-B233 = Range("B233").Value
-C233 = Range("C233").Value
-If B233 = C233 Then
-Range("D233").Value = "OK"
-Else
-Range("D233").Value = "NG"
-End If
-End Function
-
-Function test_xlHierarchy(ByRef num)
-Range("A234").Clear
-Range("B234").Clear
-Range("C234").Clear
-Range("D234").Clear
-Range("A234").Value = "xlHierarchy"
-Range("B234").Value = 1
-Range("C234").Value = num
-B234 = Range("B234").Value
-C234 = Range("C234").Value
-If B234 = C234 Then
-Range("D234").Value = "OK"
-Else
-Range("D234").Value = "NG"
-End If
-End Function
-
-Function test_xlMeasure(ByRef num)
-Range("A235").Clear
-Range("B235").Clear
-Range("C235").Clear
-Range("D235").Clear
-Range("A235").Value = "xlMeasure"
-Range("B235").Value = 2
-Range("C235").Value = num
-B235 = Range("B235").Value
-C235 = Range("C235").Value
-If B235 = C235 Then
-Range("D235").Value = "OK"
-Else
-Range("D235").Value = "NG"
-End If
-End Function
-
-Function test_xlSet(ByRef num)
-Range("A236").Clear
-Range("B236").Clear
-Range("C236").Clear
-Range("D236").Clear
-Range("A236").Value = "xlSet"
-Range("B236").Value = 3
-Range("C236").Value = num
-B236 = Range("B236").Value
-C236 = Range("C236").Value
-If B236 = C236 Then
-Range("D236").Value = "OK"
-Else
-Range("D236").Value = "NG"
-End If
-End Function
-
-Function test_xlCopy(ByRef num)
-Range("A237").Clear
-Range("B237").Clear
-Range("C237").Clear
-Range("D237").Clear
-Range("A237").Value = "xlCopy"
-Range("B237").Value = 1
-Range("C237").Value = num
-B237 = Range("B237").Value
-C237 = Range("C237").Value
-If B237 = C237 Then
-Range("D237").Value = "OK"
-Else
-Range("D237").Value = "NG"
-End If
-End Function
-
-Function test_xlCut(ByRef num)
-Range("A238").Clear
-Range("B238").Clear
-Range("C238").Clear
-Range("D238").Clear
-Range("A238").Value = "xlCut"
-Range("B238").Value = 2
-Range("C238").Value = num
-B238 = Range("B238").Value
-C238 = Range("C238").Value
-If B238 = C238 Then
-Range("D238").Value = "OK"
-Else
-Range("D238").Value = "NG"
-End If
-End Function
-
-Function test_xlValidAlterInformation(ByRef num)
-Range("A239").Clear
-Range("B239").Clear
-Range("C239").Clear
-Range("D239").Clear
-Range("A239").Value = "xlValidAlterInformation"
-Range("B239").Value = 3
-Range("C239").Value = num
-B239 = Range("B239").Value
-C239 = Range("C239").Value
-If B239 = C239 Then
-Range("D239").Value = "OK"
-Else
-Range("D239").Value = "NG"
-End If
-End Function
-
-Function test_xlValidAlterStop(ByRef num)
-Range("A240").Clear
-Range("B240").Clear
-Range("C240").Clear
-Range("D240").Clear
-Range("A240").Value = "xlValidAlterStop"
-Range("B240").Value = 1
-Range("C240").Value = num
-B240 = Range("B240").Value
-C240 = Range("C240").Value
-If B240 = C240 Then
-Range("D240").Value = "OK"
-Else
-Range("D240").Value = "NG"
-End If
-End Function
-
-Function test_xlValidAlterWarning(ByRef num)
-Range("A241").Clear
-Range("B241").Clear
-Range("C241").Clear
-Range("D241").Clear
-Range("A241").Value = "xlValidAlterWarning"
-Range("B241").Value = 2
-Range("C241").Value = num
-B241 = Range("B241").Value
-C241 = Range("C241").Value
-If B241 = C241 Then
-Range("D241").Value = "OK"
-Else
-Range("D241").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateCustom(ByRef num)
-Range("A242").Clear
-Range("B242").Clear
-Range("C242").Clear
-Range("D242").Clear
-Range("A242").Value = "xlValidateCustom"
-Range("B242").Value = 7
-Range("C242").Value = num
-B242 = Range("B242").Value
-C242 = Range("C242").Value
-If B242 = C242 Then
-Range("D242").Value = "OK"
-Else
-Range("D242").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateDate(ByRef num)
-Range("A243").Clear
-Range("B243").Clear
-Range("C243").Clear
-Range("D243").Clear
-Range("A243").Value = "xlValidateDate"
-Range("B243").Value = 4
-Range("C243").Value = num
-B243 = Range("B243").Value
-C243 = Range("C243").Value
-If B243 = C243 Then
-Range("D243").Value = "OK"
-Else
-Range("D243").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateDecimal(ByRef num)
-Range("A244").Clear
-Range("B244").Clear
-Range("C244").Clear
-Range("D244").Clear
-Range("A244").Value = "xlValidateDecimal"
-Range("B244").Value = 2
-Range("C244").Value = num
-B244 = Range("B244").Value
-C244 = Range("C244").Value
-If B244 = C244 Then
-Range("D244").Value = "OK"
-Else
-Range("D244").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateInputOnly(ByRef num)
-Range("A245").Clear
-Range("B245").Clear
-Range("C245").Clear
-Range("D245").Clear
-Range("A245").Value = "xlValidateInputOnly"
-Range("B245").Value = 0
-Range("C245").Value = num
-B245 = Range("B245").Value
-C245 = Range("C245").Value
-If B245 = C245 Then
-Range("D245").Value = "OK"
-Else
-Range("D245").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateList(ByRef num)
-Range("A246").Clear
-Range("B246").Clear
-Range("C246").Clear
-Range("D246").Clear
-Range("A246").Value = "xlValidateList"
-Range("B246").Value = 3
-Range("C246").Value = num
-B246 = Range("B246").Value
-C246 = Range("C246").Value
-If B246 = C246 Then
-Range("D246").Value = "OK"
-Else
-Range("D246").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateTextLength(ByRef num)
-Range("A247").Clear
-Range("B247").Clear
-Range("C247").Clear
-Range("D247").Clear
-Range("A247").Value = "xlValidateTextLength"
-Range("B247").Value = 6
-Range("C247").Value = num
-B247 = Range("B247").Value
-C247 = Range("C247").Value
-If B247 = C247 Then
-Range("D247").Value = "OK"
-Else
-Range("D247").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateTime(ByRef num)
-Range("A248").Clear
-Range("B248").Clear
-Range("C248").Clear
-Range("D248").Clear
-Range("A248").Value = "xlValidateTime"
-Range("B248").Value = 5
-Range("C248").Value = num
-B248 = Range("B248").Value
-C248 = Range("C248").Value
-If B248 = C248 Then
-Range("D248").Value = "OK"
-Else
-Range("D248").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateWholeNumber(ByRef num)
-Range("A249").Clear
-Range("B249").Clear
-Range("C249").Clear
-Range("D249").Clear
-Range("A249").Value = "xlValidateWholeNumber"
-Range("B249").Value = 1
-Range("C249").Value = num
-B249 = Range("B249").Value
-C249 = Range("C249").Value
-If B249 = C249 Then
-Range("D249").Value = "OK"
-Else
-Range("D249").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionAbove(ByRef num)
-Range("A250").Clear
-Range("B250").Clear
-Range("C250").Clear
-Range("D250").Clear
-Range("A250").Value = "xlLabelPositionAbove"
-Range("B250").Value = 0
-Range("C250").Value = num
-B250 = Range("B250").Value
-C250 = Range("C250").Value
-If B250 = C250 Then
-Range("D250").Value = "OK"
-Else
-Range("D250").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionBelow(ByRef num)
-Range("A251").Clear
-Range("B251").Clear
-Range("C251").Clear
-Range("D251").Clear
-Range("A251").Value = "xlLabelPositionBelow"
-Range("B251").Value = 1
-Range("C251").Value = num
-B251 = Range("B251").Value
-C251 = Range("C251").Value
-If B251 = C251 Then
-Range("D251").Value = "OK"
-Else
-Range("D251").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionBestFit(ByRef num)
-Range("A252").Clear
-Range("B252").Clear
-Range("C252").Clear
-Range("D252").Clear
-Range("A252").Value = "xlLabelPositionBestFit"
-Range("B252").Value = 5
-Range("C252").Value = num
-B252 = Range("B252").Value
-C252 = Range("C252").Value
-If B252 = C252 Then
-Range("D252").Value = "OK"
-Else
-Range("D252").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionBestCenter(ByRef num)
-Range("A253").Clear
-Range("B253").Clear
-Range("C253").Clear
-Range("D253").Clear
-Range("A253").Value = "xlLabelPositionBestCenter"
-Range("B253").Value = -4108
-Range("C253").Value = num
-B253 = Range("B253").Value
-C253 = Range("C253").Value
-If B253 = C253 Then
-Range("D253").Value = "OK"
-Else
-Range("D253").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionBestCustom(ByRef num)
-Range("A254").Clear
-Range("B254").Clear
-Range("C254").Clear
-Range("D254").Clear
-Range("A254").Value = "xlLabelPositionBestCustom"
-Range("B254").Value = 7
-Range("C254").Value = num
-B254 = Range("B254").Value
-C254 = Range("C254").Value
-If B254 = C254 Then
-Range("D254").Value = "OK"
-Else
-Range("D254").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionInsideBase(ByRef num)
-Range("A255").Clear
-Range("B255").Clear
-Range("C255").Clear
-Range("D255").Clear
-Range("A255").Value = "xlLabelPositionInsideBase"
-Range("B255").Value = 4
-Range("C255").Value = num
-B255 = Range("B255").Value
-C255 = Range("C255").Value
-If B255 = C255 Then
-Range("D255").Value = "OK"
-Else
-Range("D255").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionInsideEnd(ByRef num)
-Range("A256").Clear
-Range("B256").Clear
-Range("C256").Clear
-Range("D256").Clear
-Range("A256").Value = "xlLabelPositionInsideEnd"
-Range("B256").Value = 3
-Range("C256").Value = num
-B256 = Range("B256").Value
-C256 = Range("C256").Value
-If B256 = C256 Then
-Range("D256").Value = "OK"
-Else
-Range("D256").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionInsideLeft(ByRef num)
-Range("A257").Clear
-Range("B257").Clear
-Range("C257").Clear
-Range("D257").Clear
-Range("A257").Value = "xlLabelPositionInsideLeft"
-Range("B257").Value = -4131
-Range("C257").Value = num
-B257 = Range("B257").Value
-C257 = Range("C257").Value
-If B257 = C257 Then
-Range("D257").Value = "OK"
-Else
-Range("D257").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionMixed(ByRef num)
-Range("A258").Clear
-Range("B258").Clear
-Range("C258").Clear
-Range("D258").Clear
-Range("A258").Value = "xlLabelPositionMixed"
-Range("B258").Value = 6
-Range("C258").Value = num
-B258 = Range("B258").Value
-C258 = Range("C258").Value
-If B258 = C258 Then
-Range("D258").Value = "OK"
-Else
-Range("D258").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionOutsideEnd(ByRef num)
-Range("A259").Clear
-Range("B259").Clear
-Range("C259").Clear
-Range("D259").Clear
-Range("A259").Value = "xlLabelPositionOutsideEnd"
-Range("B259").Value = 2
-Range("C259").Value = num
-B259 = Range("B259").Value
-C259 = Range("C259").Value
-If B259 = C259 Then
-Range("D259").Value = "OK"
-Else
-Range("D259").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionRight(ByRef num)
-Range("A260").Clear
-Range("B260").Clear
-Range("C260").Clear
-Range("D260").Clear
-Range("A260").Value = "xlLabelPositionRight"
-Range("B260").Value = -4152
-Range("C260").Value = num
-B260 = Range("B260").Value
-C260 = Range("C260").Value
-If B260 = C260 Then
-Range("D260").Value = "OK"
-Else
-Range("D260").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelSeparatorDefault(ByRef num)
-Range("A261").Clear
-Range("B261").Clear
-Range("C261").Clear
-Range("D261").Clear
-Range("A261").Value = "xlDataLabelSeparatorDefault"
-Range("B261").Value = 1
-Range("C261").Value = num
-B261 = Range("B261").Value
-C261 = Range("C261").Value
-If B261 = C261 Then
-Range("D261").Value = "OK"
-Else
-Range("D261").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowBubbleSizes(ByRef num)
-Range("A262").Clear
-Range("B262").Clear
-Range("C262").Clear
-Range("D262").Clear
-Range("A262").Value = "xlDataLabelsShowBubbleSizes"
-Range("B262").Value = 6
-Range("C262").Value = num
-B262 = Range("B262").Value
-C262 = Range("C262").Value
-If B262 = C262 Then
-Range("D262").Value = "OK"
-Else
-Range("D262").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowLabel(ByRef num)
-Range("A263").Clear
-Range("B263").Clear
-Range("C263").Clear
-Range("D263").Clear
-Range("A263").Value = "xlDataLabelsShowLabel"
-Range("B263").Value = 4
-Range("C263").Value = num
-B263 = Range("B263").Value
-C263 = Range("C263").Value
-If B263 = C263 Then
-Range("D263").Value = "OK"
-Else
-Range("D263").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowLabelAndPercent(ByRef num)
-Range("A264").Clear
-Range("B264").Clear
-Range("C264").Clear
-Range("D264").Clear
-Range("A264").Value = "xlDataLabelsShowLabelAndPercent"
-Range("B264").Value = 5
-Range("C264").Value = num
-B264 = Range("B264").Value
-C264 = Range("C264").Value
-If B264 = C264 Then
-Range("D264").Value = "OK"
-Else
-Range("D264").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowNone(ByRef num)
-Range("A265").Clear
-Range("B265").Clear
-Range("C265").Clear
-Range("D265").Clear
-Range("A265").Value = "xlDataLabelsShowNone"
-Range("B265").Value = -4142
-Range("C265").Value = num
-B265 = Range("B265").Value
-C265 = Range("C265").Value
-If B265 = C265 Then
-Range("D265").Value = "OK"
-Else
-Range("D265").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowPercent(ByRef num)
-Range("A266").Clear
-Range("B266").Clear
-Range("C266").Clear
-Range("D266").Clear
-Range("A266").Value = "xlDataLabelsShowPercent"
-Range("B266").Value = 3
-Range("C266").Value = num
-B266 = Range("B266").Value
-C266 = Range("C266").Value
-If B266 = C266 Then
-Range("D266").Value = "OK"
-Else
-Range("D266").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowValue(ByRef num)
-Range("A267").Clear
-Range("B267").Clear
-Range("C267").Clear
-Range("D267").Clear
-Range("A267").Value = "xlDataLabelsShowValue"
-Range("B267").Value = 2
-Range("C267").Value = num
-B267 = Range("B267").Value
-C267 = Range("C267").Value
-If B267 = C267 Then
-Range("D267").Value = "OK"
-Else
-Range("D267").Value = "NG"
-End If
-End Function
-
-Function test_xlDay(ByRef num)
-Range("A268").Clear
-Range("B268").Clear
-Range("C268").Clear
-Range("D268").Clear
-Range("A268").Value = "xlDay"
-Range("B268").Value = 1
-Range("C268").Value = num
-B268 = Range("B268").Value
-C268 = Range("C268").Value
-If B268 = C268 Then
-Range("D268").Value = "OK"
-Else
-Range("D268").Value = "NG"
-End If
-End Function
-
-Function test_xlMonth(ByRef num)
-Range("A269").Clear
-Range("B269").Clear
-Range("C269").Clear
-Range("D269").Clear
-Range("A269").Value = "xlMonth"
-Range("B269").Value = 3
-Range("C269").Value = num
-B269 = Range("B269").Value
-C269 = Range("C269").Value
-If B269 = C269 Then
-Range("D269").Value = "OK"
-Else
-Range("D269").Value = "NG"
-End If
-End Function
-
-Function test_xlWeekday(ByRef num)
-Range("A270").Clear
-Range("B270").Clear
-Range("C270").Clear
-Range("D270").Clear
-Range("A270").Value = "xlWeekday"
-Range("B270").Value = 2
-Range("C270").Value = num
-B270 = Range("B270").Value
-C270 = Range("C270").Value
-If B270 = C270 Then
-Range("D270").Value = "OK"
-Else
-Range("D270").Value = "NG"
-End If
-End Function
-
-Function test_xlYear(ByRef num)
-Range("A271").Clear
-Range("B271").Clear
-Range("C271").Clear
-Range("D271").Clear
-Range("A271").Value = "xlYear"
-Range("B271").Value = 4
-Range("C271").Value = num
-B271 = Range("B271").Value
-C271 = Range("C271").Value
-If B271 = C271 Then
-Range("D271").Value = "OK"
-Else
-Range("D271").Value = "NG"
-End If
-End Function
-
-Function test_xlAutoFill(ByRef num)
-Range("A272").Clear
-Range("B272").Clear
-Range("C272").Clear
-Range("D272").Clear
-Range("A272").Value = "xlAutoFill"
-Range("B272").Value = 4
-Range("C272").Value = num
-B272 = Range("B272").Value
-C272 = Range("C272").Value
-If B272 = C272 Then
-Range("D272").Value = "OK"
-Else
-Range("D272").Value = "NG"
-End If
-End Function
-
-Function test_xlChronological(ByRef num)
-Range("A273").Clear
-Range("B273").Clear
-Range("C273").Clear
-Range("D273").Clear
-Range("A273").Value = "xlChronological"
-Range("B273").Value = 3
-Range("C273").Value = num
-B273 = Range("B273").Value
-C273 = Range("C273").Value
-If B273 = C273 Then
-Range("D273").Value = "OK"
-Else
-Range("D273").Value = "NG"
-End If
-End Function
-
-Function test_xlDataSeriesLinear(ByRef num)
-Range("A274").Clear
-Range("B274").Clear
-Range("C274").Clear
-Range("D274").Clear
-Range("A274").Value = "xlDataSeriesLinear"
-Range("B274").Value = -4132
-Range("C274").Value = num
-B274 = Range("B274").Value
-C274 = Range("C274").Value
-If B274 = C274 Then
-Range("D274").Value = "OK"
-Else
-Range("D274").Value = "NG"
-End If
-End Function
-
-Function test_xlGrowth(ByRef num)
-Range("A275").Clear
-Range("B275").Clear
-Range("C275").Clear
-Range("D275").Clear
-Range("A275").Value = "xlGrowth"
-Range("B275").Value = 2
-Range("C275").Value = num
-B275 = Range("B275").Value
-C275 = Range("C275").Value
-If B275 = C275 Then
-Range("D275").Value = "OK"
-Else
-Range("D275").Value = "NG"
-End If
-End Function
-
-Function test_xlShiftToLeft(ByRef num)
-Range("A276").Clear
-Range("B276").Clear
-Range("C276").Clear
-Range("D276").Clear
-Range("A276").Value = "xlShiftToLeft"
-Range("B276").Value = -4159
-Range("C276").Value = num
-B276 = Range("B276").Value
-C276 = Range("C276").Value
-If B276 = C276 Then
-Range("D276").Value = "OK"
-Else
-Range("D276").Value = "NG"
-End If
-End Function
-
-Function test_xlShiftUp(ByRef num)
-Range("A277").Clear
-Range("B277").Clear
-Range("C277").Clear
-Range("D277").Clear
-Range("A277").Value = "xlShiftUp"
-Range("B277").Value = -4162
-Range("C277").Value = num
-B277 = Range("B277").Value
-C277 = Range("C277").Value
-If B277 = C277 Then
-Range("D277").Value = "OK"
-Else
-Range("D277").Value = "NG"
-End If
-End Function
-
-Function test_xlDown(ByRef num)
-Range("A278").Clear
-Range("B278").Clear
-Range("C278").Clear
-Range("D278").Clear
-Range("A278").Value = "xlDown"
-Range("B278").Value = -4121
-Range("C278").Value = num
-B278 = Range("B278").Value
-C278 = Range("C278").Value
-If B278 = C278 Then
-Range("D278").Value = "OK"
-Else
-Range("D278").Value = "NG"
-End If
-End Function
-
-Function test_xlToLeft(ByRef num)
-Range("A279").Clear
-Range("B279").Clear
-Range("C279").Clear
-Range("D279").Clear
-Range("A279").Value = "xlToLeft"
-Range("B279").Value = -4159
-Range("C279").Value = num
-B279 = Range("B279").Value
-C279 = Range("C279").Value
-If B279 = C279 Then
-Range("D279").Value = "OK"
-Else
-Range("D279").Value = "NG"
-End If
-End Function
-
-Function test_xlToRight(ByRef num)
-Range("A280").Clear
-Range("B280").Clear
-Range("C280").Clear
-Range("D280").Clear
-Range("A280").Value = "xlToRight"
-Range("B280").Value = -4161
-Range("C280").Value = num
-B280 = Range("B280").Value
-C280 = Range("C280").Value
-If B280 = C280 Then
-Range("D280").Value = "OK"
-Else
-Range("D280").Value = "NG"
-End If
-End Function
-
-Function test_xlUp(ByRef num)
-Range("A281").Clear
-Range("B281").Clear
-Range("C281").Clear
-Range("D281").Clear
-Range("A281").Value = "xlUp"
-Range("B281").Value = -4162
-Range("C281").Value = num
-B281 = Range("B281").Value
-C281 = Range("C281").Value
-If B281 = C281 Then
-Range("D281").Value = "OK"
-Else
-Range("D281").Value = "NG"
-End If
-End Function
-
-Function test_xlInterpolated(ByRef num)
-Range("A282").Clear
-Range("B282").Clear
-Range("C282").Clear
-Range("D282").Clear
-Range("A282").Value = "xlInterpolated"
-Range("B282").Value = 3
-Range("C282").Value = num
-B282 = Range("B282").Value
-C282 = Range("C282").Value
-If B282 = C282 Then
-Range("D282").Value = "OK"
-Else
-Range("D282").Value = "NG"
-End If
-End Function
-
-Function test_xlNotPlotted(ByRef num)
-Range("A283").Clear
-Range("B283").Clear
-Range("C283").Clear
-Range("D283").Clear
-Range("A283").Value = "xlNotPlotted"
-Range("B283").Value = 2
-Range("C283").Value = num
-B283 = Range("B283").Value
-C283 = Range("C283").Value
-If B283 = C283 Then
-Range("D283").Value = "OK"
-Else
-Range("D283").Value = "NG"
-End If
-End Function
-
-Function test_xlZero(ByRef num)
-Range("A284").Clear
-Range("B284").Clear
-Range("C284").Clear
-Range("D284").Clear
-Range("A284").Value = "xlZero"
-Range("B284").Value = 1
-Range("C284").Value = num
-B284 = Range("B284").Value
-C284 = Range("C284").Value
-If B284 = C284 Then
-Range("D284").Value = "OK"
-Else
-Range("D284").Value = "NG"
-End If
-End Function
-
-Function test_xlDisplayShapes(ByRef num)
-Range("A285").Clear
-Range("B285").Clear
-Range("C285").Clear
-Range("D285").Clear
-Range("A285").Value = "xlDisplayShapes"
-Range("B285").Value = -4104
-Range("C285").Value = num
-B285 = Range("B285").Value
-C285 = Range("C285").Value
-If B285 = C285 Then
-Range("D285").Value = "OK"
-Else
-Range("D285").Value = "NG"
-End If
-End Function
-
-Function test_xlHide(ByRef num)
-Range("A286").Clear
-Range("B286").Clear
-Range("C286").Clear
-Range("D286").Clear
-Range("A286").Value = "xlHide"
-Range("B286").Value = 3
-Range("C286").Value = num
-B286 = Range("B286").Value
-C286 = Range("C286").Value
-If B286 = C286 Then
-Range("D286").Value = "OK"
-Else
-Range("D286").Value = "NG"
-End If
-End Function
-
-Function test_xlPlaceholders(ByRef num)
-Range("A287").Clear
-Range("B287").Clear
-Range("C287").Clear
-Range("D287").Clear
-Range("A287").Value = "xlPlaceholders"
-Range("B287").Value = 2
-Range("C287").Value = num
-B287 = Range("B287").Value
-C287 = Range("C287").Value
-If B287 = C287 Then
-Range("D287").Value = "OK"
-Else
-Range("D287").Value = "NG"
-End If
-End Function
-
-Function test_xlHundredMillions(ByRef num)
-Range("A288").Clear
-Range("B288").Clear
-Range("C288").Clear
-Range("D288").Clear
-Range("A288").Value = "xlHundredMillions"
-Range("B288").Value = -8
-Range("C288").Value = num
-B288 = Range("B288").Value
-C288 = Range("C288").Value
-If B288 = C288 Then
-Range("D288").Value = "OK"
-Else
-Range("D288").Value = "NG"
-End If
-End Function
-
-Function test_xlHundreds(ByRef num)
-Range("A289").Clear
-Range("B289").Clear
-Range("C289").Clear
-Range("D289").Clear
-Range("A289").Value = "xlHundreds"
-Range("B289").Value = -2
-Range("C289").Value = num
-B289 = Range("B289").Value
-C289 = Range("C289").Value
-If B289 = C289 Then
-Range("D289").Value = "OK"
-Else
-Range("D289").Value = "NG"
-End If
-End Function
-
-Function test_xlHundredThousands(ByRef num)
-Range("A290").Clear
-Range("B290").Clear
-Range("C290").Clear
-Range("D290").Clear
-Range("A290").Value = "xlHundredThousands"
-Range("B290").Value = -5
-Range("C290").Value = num
-B290 = Range("B290").Value
-C290 = Range("C290").Value
-If B290 = C290 Then
-Range("D290").Value = "OK"
-Else
-Range("D290").Value = "NG"
-End If
-End Function
-
-Function test_xlMillionMillons(ByRef num)
-Range("A291").Clear
-Range("B291").Clear
-Range("C291").Clear
-Range("D291").Clear
-Range("A291").Value = "xlMillionMillons"
-Range("B291").Value = -10
-Range("C291").Value = num
-B291 = Range("B291").Value
-C291 = Range("C291").Value
-If B291 = C291 Then
-Range("D291").Value = "OK"
-Else
-Range("D291").Value = "NG"
-End If
-End Function
-
-Function test_xlMillions(ByRef num)
-Range("A292").Clear
-Range("B292").Clear
-Range("C292").Clear
-Range("D292").Clear
-Range("A292").Value = "xlMillions"
-Range("B292").Value = -6
-Range("C292").Value = num
-B292 = Range("B292").Value
-C292 = Range("C292").Value
-If B292 = C292 Then
-Range("D292").Value = "OK"
-Else
-Range("D292").Value = "NG"
-End If
-End Function
-
-Function test_xlTenMillions(ByRef num)
-Range("A293").Clear
-Range("B293").Clear
-Range("C293").Clear
-Range("D293").Clear
-Range("A293").Value = "xlTenMillions"
-Range("B293").Value = -7
-Range("C293").Value = num
-B293 = Range("B293").Value
-C293 = Range("C293").Value
-If B293 = C293 Then
-Range("D293").Value = "OK"
-Else
-Range("D293").Value = "NG"
-End If
-End Function
-
-Function test_xlTenThousands(ByRef num)
-Range("A294").Clear
-Range("B294").Clear
-Range("C294").Clear
-Range("D294").Clear
-Range("A294").Value = "xlTenThousands"
-Range("B294").Value = -4
-Range("C294").Value = num
-B294 = Range("B294").Value
-C294 = Range("C294").Value
-If B294 = C294 Then
-Range("D294").Value = "OK"
-Else
-Range("D294").Value = "NG"
-End If
-End Function
-
-Function test_xlThousandMillions(ByRef num)
-Range("A295").Clear
-Range("B295").Clear
-Range("C295").Clear
-Range("D295").Clear
-Range("A295").Value = "xlThousandMillions"
-Range("B295").Value = -9
-Range("C295").Value = num
-B295 = Range("B295").Value
-C295 = Range("C295").Value
-If B295 = C295 Then
-Range("D295").Value = "OK"
-Else
-Range("D295").Value = "NG"
-End If
-End Function
-
-Function test_xlThousands(ByRef num)
-Range("A296").Clear
-Range("B296").Clear
-Range("C296").Clear
-Range("D296").Clear
-Range("A296").Value = "xlThousands"
-Range("B296").Value = -3
-Range("C296").Value = num
-B296 = Range("B296").Value
-C296 = Range("C296").Value
-If B296 = C296 Then
-Range("D296").Value = "OK"
-Else
-Range("D296").Value = "NG"
-End If
-End Function
-
-<<<<<<
-======================
-Module5
->>>>>>
-Attribute VB_Name = "Module5"
-
-Sub main_5()
-test_XlEditionFormat (XlEditionFormat)
-test_xlAutomaticUpdate (xlAutomaticUpdate)
-test_xlCancel (xlCancel)
-test_xlChangeAttributes (xlChangeAttributes)
-test_xlManualUpdate (xlManualUpdate)
-test_xlOpenSource (xlOpenSource)
-test_xlSelect (xlSelect)
-test_xlSendPublisher (xlSendPublisher)
-test_xlUpdateSubscriber (xlUpdateSubscriber)
-test_xlPublisher (xlPublisher)
-test_xlSubscriber (xlSubscriber)
-test_xlDisabled (xlDisabled)
-test_xlErrorHandler (xlErrorHandler)
-test_xlInterrupt (xlInterrupt)
-test_xlNoRestrictions (xlNoRestrictions)
-test_xlNoSelection (xlNoSelection)
-test_xlUnlockedCells (xlUnlockedCells)
-test_xlCap (xlCap)
-test_xlNoCap (xlNoCap)
-test_xlX (xlX)
-test_xlY (xlY)
-test_xlErrorBarIncludeBoth (xlErrorBarIncludeBoth)
-test_xlErrorBarIncludeMinusValues (xlErrorBarIncludeMinusValues)
-test_xlErrorBarIncludeNone (xlErrorBarIncludeNone)
-test_xlErrorBarIncludePlusValues (xlErrorBarIncludePlusValues)
-test_xlErrorBarTypeCustom (xlErrorBarTypeCustom)
-test_xlErrorBarTypeFixedValue (xlErrorBarTypeFixedValue)
-test_xlErrorBarTypePercent (xlErrorBarTypePercent)
-test_xlErrorBarTypeStDev (xlErrorBarTypeStDev)
-test_xlErrorBarTypeStError (xlErrorBarTypeStError)
-test_xlEmptyCellReferences (xlEmptyCellReferences)
-test_xlEvaluateToError (xlEvaluateToError)
-test_xlInconsistentFormula (xlInconsistentFormula)
-test_xlListDataValidation (xlListDataValidation)
-test_xlNumberAsText (xlNumberAsText)
-test_xlOmittedCells (xlOmittedCells)
-test_xlTextDate (xlTextDate)
-test_xlUnlockedFormulaCells (xlUnlockedFormulaCells)
-test_xlReadOnly (xlReadOnly)
-test_xlReadWrite (xlReadWrite)
-test_xlAddIn (xlAddIn)
-test_xlCSV (xlCSV)
-test_xlCSVMac (xlCSVMac)
-test_xlCSVMSDOS (xlCSVMSDOS)
-test_xlCSVWindows (xlCSVWindows)
-test_xlCurrentPlatformText (xlCurrentPlatformText)
-test_xlDBF2 (xlDBF2)
-test_xlDBF3 (xlDBF3)
-test_xlDBF4 (xlDBF4)
-test_xlDIF (xlDIF)
-test_xlExcel2 (xlExcel2)
-test_xlExcel2FarEast (xlExcel2FarEast)
-test_xlExcel3 (xlExcel3)
-test_xlExcel4 (xlExcel4)
-test_xlExcel4Wordbook (xlExcel4Wordbook)
-test_xlExcel5 (xlExcel5)
-test_xlExcel7 (xlExcel7)
-test_xlExcel9795 (xlExcel9795)
-test_xlHtml (xlHtml)
-test_xlIntlAddIn (xlIntlAddIn)
-test_xlIntlMacro (xlIntlMacro)
-test_xlSYLK (xlSYLK)
-test_xlTemplate (xlTemplate)
-test_xlTextMac (xlTextMac)
-test_xlTextMSDOS (xlTextMSDOS)
-test_xlTextPrinter (xlTextPrinter)
-test_xlTextWindows (xlTextWindows)
-test_xlUnicodeText (xlUnicodeText)
-test_xlWebArchive (xlWebArchive)
-test_xlWJ2WD1 (xlWJ2WD1)
-test_xlWJ3 (xlWJ3)
-test_xlWJ3FJ3 (xlWJ3FJ3)
-test_xlWK1 (xlWK1)
-test_xlWK1ALL (xlWK1ALL)
-test_xlWK1FMT (xlWK1FMT)
-test_xlWK3 (xlWK3)
-test_xlWK3FM3 (xlWK3FM3)
-test_xlWK4 (xlWK4)
-test_xlWKS (xlWKS)
-test_xlWordbookNormal (xlWordbookNormal)
-test_xlWords2FarEast (xlWords2FarEast)
-test_xlWQ1 (xlWQ1)
-test_xlXMLSpredsheet (xlXMLSpredsheet)
-test_xlFillWithAll (xlFillWithAll)
-test_xlFillWithContents (xlFillWithContents)
-test_xlFillWithFormats (xlFillWithFormats)
-test_xlFilterCopy (xlFilterCopy)
-test_xlFilterInPlace (xlFilterInPlace)
-test_xlComments (xlComments)
-test_xlFormulas (xlFormulas)
-test_xlValues (xlValues)
-test_xlButtonControl (xlButtonControl)
-test_xlCheckBox (xlCheckBox)
-test_xlDropDown (xlDropDown)
-test_xlEditBox (xlEditBox)
-test_xlGroupBox (xlGroupBox)
-test_xlLabel (xlLabel)
-test_xlListBox (xlListBox)
-test_xlOptionButton (xlOptionButton)
-test_xlSchollBar (xlSchollBar)
-test_xlSpinner (xlSpinner)
-test_xlBetween (xlBetween)
-test_xlEqual (xlEqual)
-test_xlGreater (xlGreater)
-test_xlGreaterEqual (xlGreaterEqual)
-test_xlLess (xlLess)
-test_xlLessEqual (xlLessEqual)
-test_xlNotBetween (xlNotBetween)
-test_xlNotEqual (xlNotEqual)
-test_xlCellValue (xlCellValue)
-test_xlExpression (xlExpression)
-test_xlColumnLabels (xlColumnLabels)
-test_xlMixedLabels (xlMixedLabels)
-test_xlNoLabels (xlNoLabels)
-test_xlRowLabels (xlRowLabels)
-test_xlHAlignCenter (xlHAlignCenter)
-test_xlHAlignCenterAcrossSelection (xlHAlignCenterAcrossSelection)
-test_xlHAlignDistributed (xlHAlignDistributed)
-test_xlHAlignFull (xlHAlignFull)
-test_xlHAlignGeneral (xlHAlignGeneral)
-test_xlHAlignJustify (xlHAlignJustify)
-test_xlHAlignLeft (xlHAlignLeft)
-test_xlHAlignRight (xlHAlignRight)
-test_xlHebrewFullScript (xlHebrewFullScript)
-test_xlHebrewMixedAuthorizedScript (xlHebrewMixedAuthorizedScript)
-test_xlHebrewMixedScript (xlHebrewMixedScript)
-test_xlHebrewPartialScript (xlHebrewPartialScript)
-test_xlAllChanges (xlAllChanges)
-test_xlNotYetReviewed (xlNotYetReviewed)
-test_xlSinceMyLastSave (xlSinceMyLastSave)
-test_xlHtmlCalc (xlHtmlCalc)
-test_xlHtmlChart (xlHtmlChart)
-test_xlHtmlList (xlHtmlList)
-test_xlHtmlStatic (xlHtmlStatic)
-test_xlIMEModeAlpha (xlIMEModeAlpha)
-test_xlIMEModeAlphaFull (xlIMEModeAlphaFull)
-test_xlIMEModeDisable (xlIMEModeDisable)
-test_xlIMEModeHangul (xlIMEModeHangul)
-test_xlIMEModeHangulFull (xlIMEModeHangulFull)
-test_xlIMEModeHiragana (xlIMEModeHiragana)
-test_xlIMEModeKatakana (xlIMEModeKatakana)
-test_xlIMEModeKatakanaHalf (xlIMEModeKatakanaHalf)
-test_xlIMEModeNoControl (xlIMEModeNoControl)
-test_xlIMEModeOff (xlIMEModeOff)
-test_xlIMEModeOn (xlIMEModeOn)
-test_xlPivotTableReport (xlPivotTableReport)
-test_xlQueryTable (xlQueryTable)
-test_xlFormatFromLeftOrAbove (xlFormatFromLeftOrAbove)
-test_xlFormatFromRightOrAbove (xlFormatFromRightOrAbove)
-test_xlShiftDown (xlShiftDown)
-test_xlShiftToRight (xlShiftToRight)
-test_xlOutline (xlOutline)
-test_xlTabular (xlTabular)
-test_xlLegendPositionBottom (xlLegendPositionBottom)
-test_xlLegendPositionCorner (xlLegendPositionCorner)
-test_xlLegendPositionLeft (xlLegendPositionLeft)
-test_xlLegendPositionRight (xlLegendPositionRight)
-test_xlLegendPositionTop (xlLegendPositionTop)
-test_xlContinuous (xlContinuous)
-test_xlDash (xlDash)
-test_xlDashDot (xlDashDot)
-test_xlDashDotDot (xlDashDotDot)
-test_xlDot (xlDot)
-test_xlDouble (xlDouble)
-test_xlLineStyleNone (xlLineStyleNone)
-test_xlSlantDashDot (xlSlantDashDot)
-test_xlExcelLink (xlExcelLink)
-test_xlPublishers (xlPublishers)
-test_xlSubscribers (xlSubscribers)
-test_xlEditionDate (xlEditionDate)
-test_xlLinkInfoStatus (xlLinkInfoStatus)
-test_xlUpdateState (xlUpdateState)
-test_xlLinkInfoOLELinks (xlLinkInfoOLELinks)
-test_xlLinkInfoPublishers (xlLinkInfoPublishers)
-test_xlLinkInfoSubscribers (xlLinkInfoSubscribers)
-test_xlLinkStatusCopiedValues (xlLinkStatusCopiedValues)
-test_xlLinkStatusIndeterminate (xlLinkStatusIndeterminate)
-test_xlLinkStatusInvalidName (xlLinkStatusInvalidName)
-test_xlLinkStatusMissingFile (xlLinkStatusMissingFile)
-test_xlLinkStatusMissingSheet (xlLinkStatusMissingSheet)
-test_xlLinkStatusNotStarted (xlLinkStatusNotStarted)
-test_xlLinkStatusOK (xlLinkStatusOK)
-test_xlLinkStatusOld (xlLinkStatusOld)
-test_xlLinkStatusSourceNotCalculated (xlLinkStatusSourceNotCalculated)
-test_xlLinkStatusSourceNotOpen (xlLinkStatusSourceNotOpen)
-test_xlLinkStatusSourceOpen (xlLinkStatusSourceOpen)
-test_xlLinkTypeExcelLinks (xlLinkTypeExcelLinks)
-test_xlLinkTypeOLELinks (xlLinkTypeOLELinks)
-test_xlListConflictDialog (xlListConflictDialog)
-test_xlListConflictDiscardAllConflicts (xlListConflictDiscardAllConflicts)
-test_xlListConflictError (xlListConflictError)
-test_xlListConflictRetryAllConflicts (xlListConflictRetryAllConflicts)
-test_xlListDataTypeCheckbox (xlListDataTypeCheckbox)
-test_xlListDataTypeChoice (xlListDataTypeChoice)
-test_xlListDataTypeChoiceMulti (xlListDataTypeChoiceMulti)
-test_xlListDataTypeCounter (xlListDataTypeCounter)
-test_xlListDataTypeCurrency (xlListDataTypeCurrency)
-test_xlListDataTypeDateTime (xlListDataTypeDateTime)
-test_xlListDataTypeHyperLink (xlListDataTypeHyperLink)
-test_xlListDataTypeListLookup (xlListDataTypeListLookup)
-test_xlListDataTypeMultiLineRichText (xlListDataTypeMultiLineRichText)
-test_xlListDataTypeMultiLineText (xlListDataTypeMultiLineText)
-test_xlListDataTypeNone (xlListDataTypeNone)
-test_xlListDataTypeNumber (xlListDataTypeNumber)
-test_xlListDataTypeText (xlListDataTypeText)
-test_xlSrcExternal (xlSrcExternal)
-test_xlSrcRange (xlSrcRange)
-test_xlSrcXml (xlSrcXml)
-test_xlColumnHeader (xlColumnHeader)
-test_xlColumnItem (xlColumnItem)
-test_xlDataHeader (xlDataHeader)
-test_xlDataItem (xlDataItem)
-test_xlPageHeader (xlPageHeader)
-test_xlPageItem (xlPageItem)
-test_xlRowHeader (xlRowHeader)
-test_xlRowItem (xlRowItem)
-test_xlTableBody (xlTableBody)
-test_xlPart (xlPart)
-test_xlWhole (xlWhole)
-test_xlMicrosoftAccess (xlMicrosoftAccess)
-test_xlMicrosoftFoxPro (xlMicrosoftFoxPro)
-test_xlMicrosoftMail (xlMicrosoftMail)
-test_xlMicrosoftPowerPoint (xlMicrosoftPowerPoint)
-test_xlMicrosoftProject (xlMicrosoftProject)
-test_xlMicrosoftSchedulePlus (xlMicrosoftSchedulePlus)
-test_xlMicrosoftWord (xlMicrosoftWord)
-test_xlMAPI (xlMAPI)
-test_xlNoMailSystem (xlNoMailSystem)
-test_xlPowerTalk (xlPowerTalk)
-test_xlMarkerStyleAutomatic (xlMarkerStyleAutomatic)
-test_xlMarkerStyleCircle (xlMarkerStyleCircle)
-test_xlMarkerStyleDash (xlMarkerStyleDash)
-test_xlMarkerStyleDiamond (xlMarkerStyleDiamond)
-test_xlMarkerStyleDot (xlMarkerStyleDot)
-test_xlMarkerStyleNone (xlMarkerStyleNone)
-test_xlMarkerStylePicture (xlMarkerStylePicture)
-test_xlMarkerStylePlus (xlMarkerStylePlus)
-test_xlMarkerStyleSquare (xlMarkerStyleSquare)
-test_xlMarkerStyleStar (xlMarkerStyleStar)
-test_xlMarkerStyleTiangle (xlMarkerStyleTiangle)
-test_xlMarkerStyleX (xlMarkerStyleX)
-test_xlNoButton (xlNoButton)
-test_xlPrimaryButton (xlPrimaryButton)
-test_xlSecondaryButton (xlSecondaryButton)
-test_xlDefault (xlDefault)
-test_xlIBeam (xlIBeam)
-test_xlNorthwestArrow (xlNorthwestArrow)
-test_xlWait (xlWait)
-test_XlOLEControl (XlOLEControl)
-test_XlOLEEmbed (XlOLEEmbed)
-test_XlOLELink (XlOLELink)
-test_XlVerbOpen (XlVerbOpen)
-test_XlVerbPrimary (XlVerbPrimary)
-test_xlFitToPage (xlFitToPage)
-test_xlFullPage (xlFullPage)
-test_xlScreenSize (xlScreenSize)
-test_xlDownThenOver (xlDownThenOver)
-test_xlOverThenDown (xlOverThenDown)
-test_xlDownward (xlDownward)
-test_xlHorizontal (xlHorizontal)
-test_xlUpward (xlUpward)
-test_xlVertical (xlVertical)
-test_xlBlanks (xlBlanks)
-test_xlButton (xlButton)
-test_xlDataAndLabel (xlDataAndLabel)
-test_xlDataOnly (xlDataOnly)
-test_xlFirstRow (xlFirstRow)
-test_xlLabelOnly (xlLabelOnly)
-test_xlOrigin (xlOrigin)
-test_XlPageBreakAutomatic (XlPageBreakAutomatic)
-test_XlPageBreakManual (XlPageBreakManual)
-test_XlPageBreakNone (XlPageBreakNone)
-test_xlPageBreakFull (xlPageBreakFull)
-test_xlPageBreakPartial (xlPageBreakPartial)
-test_xlLandscape (xlLandscape)
-test_xlPortrait (xlPortrait)
-test_xlPaper10x14 (xlPaper10x14)
-test_xlPaper11x17 (xlPaper11x17)
-test_xlPaperA3 (xlPaperA3)
-test_xlPaperA4Small (xlPaperA4Small)
-test_xlPaperA5 (xlPaperA5)
-test_xlPaperB4 (xlPaperB4)
-test_xlPaperB5 (xlPaperB5)
-test_xlPaperCsheet (xlPaperCsheet)
-test_xlPaperDsheet (xlPaperDsheet)
-test_xlPaperEnvelope10 (xlPaperEnvelope10)
-test_xlPaperEnvelope11 (xlPaperEnvelope11)
-test_xlPaperEnvelope12 (xlPaperEnvelope12)
-test_xlPaperEnvelope14 (xlPaperEnvelope14)
-test_xlPaperEnvelope9 (xlPaperEnvelope9)
-test_xlPaperEnvelopeB4 (xlPaperEnvelopeB4)
-test_xlPaperEnvelopeB5 (xlPaperEnvelopeB5)
-test_xlPaperEnvelopeB6 (xlPaperEnvelopeB6)
-test_xlPaperEnvelopeC3 (xlPaperEnvelopeC3)
-test_xlPaperEnvelopeC4 (xlPaperEnvelopeC4)
-test_xlPaperEnvelopeC5 (xlPaperEnvelopeC5)
-test_xlPaperEnvelopeC6 (xlPaperEnvelopeC6)
-test_xlPaperEnvelopeC65 (xlPaperEnvelopeC65)
-test_xlPaperEnvelopeDL (xlPaperEnvelopeDL)
-test_xlPaperEnvelopeItaly (xlPaperEnvelopeItaly)
-test_xlPaperEnvelopeMonarch (xlPaperEnvelopeMonarch)
-test_xlPaperEnvelopePersonal (xlPaperEnvelopePersonal)
-test_xlPaperEsheet (xlPaperEsheet)
-test_xlPaperExective (xlPaperExective)
-test_xlPaperFanfoldLegalGerman (xlPaperFanfoldLegalGerman)
-test_xlPaperFanfoldStdGerman (xlPaperFanfoldStdGerman)
-test_xlPaperFanfoldUS (xlPaperFanfoldUS)
-test_xlPaperFolio (xlPaperFolio)
-test_xlPaperLedger (xlPaperLedger)
-test_xlPaperLegal (xlPaperLegal)
-test_xlPaperLetter (xlPaperLetter)
-test_xlPaperLetterSmall (xlPaperLetterSmall)
-test_xlPaperNote (xlPaperNote)
-test_xlPaperQuarto (xlPaperQuarto)
-test_xlPaperStatement (xlPaperStatement)
-test_xlPaperTabloid (xlPaperTabloid)
-test_xlPaperUser (xlPaperUser)
-test_xlParameterTypeBigInt (xlParameterTypeBigInt)
-test_xlParameterTypeBinary (xlParameterTypeBinary)
-test_xlParameterTypeBit (xlParameterTypeBit)
-test_xlParameterTypeChar (xlParameterTypeChar)
-test_xlParameterTypeData (xlParameterTypeData)
-test_xlParameterTypeDecimal (xlParameterTypeDecimal)
-test_xlParameterTypeDouble (xlParameterTypeDouble)
-test_xlParameterTypeFloat (xlParameterTypeFloat)
-test_xlParameterTypeInteger (xlParameterTypeInteger)
-test_xlParameterTypeLongVarBinary (xlParameterTypeLongVarBinary)
-test_xlParameterTypeLongVarChar (xlParameterTypeLongVarChar)
-test_xlParameterTypeNumeric (xlParameterTypeNumeric)
-test_xlParameterTypeReal (xlParameterTypeReal)
-test_xlParameterTypeSmallInt (xlParameterTypeSmallInt)
-test_xlParameterTypeTime (xlParameterTypeTime)
-test_xlParameterTypeTimestamp (xlParameterTypeTimestamp)
-test_xlParameterTypeTinyInt (xlParameterTypeTinyInt)
-test_xlParameterTypeUnknown (xlParameterTypeUnknown)
-test_xlParameterTypeVarBinary (xlParameterTypeVarBinary)
-test_xlParameterTypeVarChar (xlParameterTypeVarChar)
-test_xlParameterTypeWChar (xlParameterTypeWChar)
-test_xlConstant (xlConstant)
-test_xlPrompt (xlPrompt)
-test_xlRange (xlRange)
-test_xlPasteSpecialOperationAdd (xlPasteSpecialOperationAdd)
-test_xlPasteSpecialOperationDivide (xlPasteSpecialOperationDivide)
-test_xlPasteSpecialOperationMultiply (xlPasteSpecialOperationMultiply)
-test_xlPasteSpecialOperationNone (xlPasteSpecialOperationNone)
-test_xlPasteSpecialOperationSubstract (xlPasteSpecialOperationSubstract)
-test_xlPasteAll (xlPasteAll)
-test_xlPasteAllExceptBorders (xlPasteAllExceptBorders)
-test_xlPasteAllColumnWidths (xlPasteAllColumnWidths)
-test_xlPasteComments (xlPasteComments)
-test_xlPasteFormats (xlPasteFormats)
-test_xlPasteFormulas (xlPasteFormulas)
-test_xlPasteFormulasAndNumberFormats (xlPasteFormulasAndNumberFormats)
-test_xlPasteValidation (xlPasteValidation)
-test_xlPasteValues (xlPasteValues)
-test_xlPasteValuesAndNumberFormats (xlPasteValuesAndNumberFormats)
-test_xlPatternAutomatic (xlPatternAutomatic)
-test_xlPatternChecker (xlPatternChecker)
-test_xlPatternCrissCross (xlPatternCrissCross)
-test_xlPatternDown (xlPatternDown)
-test_xlPatternGray16 (xlPatternGray16)
-test_xlPatternGray25 (xlPatternGray25)
-test_xlPatternGray50 (xlPatternGray50)
-test_xlPatternGray75 (xlPatternGray75)
-test_xlPatternGray8 (xlPatternGray8)
-test_xlPatternGrid (xlPatternGrid)
-test_xlPatternHorizontal (xlPatternHorizontal)
-test_xlPatternLightDown (xlPatternLightDown)
-test_xlPatternLightHorizontal (xlPatternLightHorizontal)
-test_xlPatternLightUp (xlPatternLightUp)
-test_xlPatternLightVertical (xlPatternLightVertical)
-test_xlPatternNone (xlPatternNone)
-test_xlPatternSemiGray75 (xlPatternSemiGray75)
-test_xlPatternSolid (xlPatternSolid)
-test_xlPatternUp (xlPatternUp)
-test_xlPatternVertical (xlPatternVertical)
-test_XlPhoneticAlignCenter (XlPhoneticAlignCenter)
-test_XlPhoneticAlignDistributed (XlPhoneticAlignDistributed)
-test_XlPhoneticAlignLeft (XlPhoneticAlignLeft)
-test_XlPhoneticAlignNoControl (XlPhoneticAlignNoControl)
-test_xlPrinter (xlPrinter)
-test_xlScreen (xlScreen)
-test_xlBMP (xlBMP)
-test_xlCGM (xlCGM)
-test_xlDRW (xlDRW)
-test_xlDXF (xlDXF)
-test_xlEPS (xlEPS)
-test_xlHGL (xlHGL)
-test_xlPCT (xlPCT)
-test_xlPCX (xlPCX)
-test_xlPIC (xlPIC)
-test_xlPLT (xlPLT)
-test_xlTIF (xlTIF)
-test_xlWMF (xlWMF)
-test_xlWPG (xlWPG)
-test_xlPivotCellBlankCell (xlPivotCellBlankCell)
-test_xlPivotCellCustomSubtotal (xlPivotCellCustomSubtotal)
-test_xlPivotCellDataField (xlPivotCellDataField)
-test_xlPivotCellDataPivotField (xlPivotCellDataPivotField)
-test_xlPivotCellGrandTotal (xlPivotCellGrandTotal)
-test_xlPivotCellPageFieldItem (xlPivotCellPageFieldItem)
-test_xlPivotCellPivotField (xlPivotCellPivotField)
-test_xlPivotCellPivotItem (xlPivotCellPivotItem)
-test_xlPivotCellSubtotal (xlPivotCellSubtotal)
-test_xlPivotCellValue (xlPivotCellValue)
-test_xlDifferenceFrom (xlDifferenceFrom)
-test_xlIndex (xlIndex)
-test_xlNoAdditionalCalculation (xlNoAdditionalCalculation)
-test_xlPercentDifferenceFrom (xlPercentDifferenceFrom)
-test_xlPercentOf (xlPercentOf)
-test_xlPercentOfColumn (xlPercentOfColumn)
-test_xlPercentOfRow (xlPercentOfRow)
-test_xlPercentOfTotal (xlPercentOfTotal)
-test_xlRunningTotal (xlRunningTotal)
-test_xlDate (xlDate)
-test_xlNumber (xlNumber)
-test_xlText (xlText)
-test_xlColumnField (xlColumnField)
-test_xlDataField (xlDataField)
-test_xlHidden (xlHidden)
-test_xlPageField (xlPageField)
-test_xlRowField (xlRowField)
-test_xlPTClassic (xlPTClassic)
-test_xlPTNone (xlPTNone)
-test_xlReport1 (xlReport1)
-test_xlReport10 (xlReport10)
-test_xlReport2 (xlReport2)
-test_xlReport3 (xlReport3)
-test_xlReport4 (xlReport4)
-test_xlReport5 (xlReport5)
-test_xlReport6 (xlReport6)
-test_xlReport7 (xlReport7)
-test_xlReport8 (xlReport8)
-test_xlReport9 (xlReport9)
-test_xlTable1 (xlTable1)
-test_xlTable10 (xlTable10)
-test_xlTable2 (xlTable2)
-test_xlTable3 (xlTable3)
-test_xlTable4 (xlTable4)
-test_xlTable5 (xlTable5)
-test_xlTable6 (xlTable6)
-test_xlTable7 (xlTable7)
-test_xlTable8 (xlTable8)
-test_xlTable9 (xlTable9)
-test_xlMissingItemsDefault (xlMissingItemsDefault)
-test_xlMissingItemsMax (xlMissingItemsMax)
-test_xlMissingItemsNone (xlMissingItemsNone)
-test_xlConsolidation (xlConsolidation)
-test_xlDatabase (xlDatabase)
-test_xlExternal (xlExternal)
-test_xlPivotTable (xlPivotTable)
-test_xlScenario (xlScenario)
-test_xlPivotTableVersion10 (xlPivotTableVersion10)
-test_xlPivotTableVersion2000 (xlPivotTableVersion2000)
-test_xlPivotTableCurrent (xlPivotTableCurrent)
-test_xlFreeFloating (xlFreeFloating)
-test_xlMove (xlMove)
-test_xlMoveAndSize (xlMoveAndSize)
-test_xlMacintosh (xlMacintosh)
-test_xlMSDOS (xlMSDOS)
-test_xlWindows (xlWindows)
-test_xlPrintErrorsBlank (xlPrintErrorsBlank)
-test_xlPrintErrorsDash (xlPrintErrorsDash)
-test_xlPrintErrorsDisplayed (xlPrintErrorsDisplayed)
-test_xlPrintErrorsNA (xlPrintErrorsNA)
-test_xlPrintLocation (xlPrintLocation)
-test_xlPrintNoComments (xlPrintNoComments)
-test_xlPrintSheetEnd (xlPrintSheetEnd)
-test_xlPriorityHigh (xlPriorityHigh)
-test_xlPriorityLow (xlPriorityLow)
-test_xlPriorityNormal (xlPriorityNormal)
-test_xlADORecordset (xlADORecordset)
-test_xlDAORecordset (xlDAORecordset)
-test_xlODBCQuery (xlODBCQuery)
-test_xlOLEDBQuery (xlOLEDBQuery)
-test_xlTextImport (xlTextImport)
-test_xlWebQuery (xlWebQuery)
-test_xlRangeAutoFormat3DEffects1 (xlRangeAutoFormat3DEffects1)
-test_xlRangeAutoFormat3DEffects2 (xlRangeAutoFormat3DEffects2)
-test_xlRangeAutoFormatAccounting1 (xlRangeAutoFormatAccounting1)
-test_xlRangeAutoFormatAccounting2 (xlRangeAutoFormatAccounting2)
-test_xlRangeAutoFormatAccounting3 (xlRangeAutoFormatAccounting3)
-test_xlRangeAutoFormatAccounting4 (xlRangeAutoFormatAccounting4)
-test_xlRangeAutoFormatClassic1 (xlRangeAutoFormatClassic1)
-test_xlRangeAutoFormatClassic2 (xlRangeAutoFormatClassic2)
-test_xlRangeAutoFormatClassic3 (xlRangeAutoFormatClassic3)
-test_xlRangeAutoFormatClassicPivotTable (xlRangeAutoFormatClassicPivotTable)
-test_xlRangeAutoFormatColor1 (xlRangeAutoFormatColor1)
-test_xlRangeAutoFormatColor2 (xlRangeAutoFormatColor2)
-test_xlRangeAutoFormatColor3 (xlRangeAutoFormatColor3)
-test_xlRangeAutoFormatList1 (xlRangeAutoFormatList1)
-test_xlRangeAutoFormatList2 (xlRangeAutoFormatList2)
-test_xlRangeAutoFormatList3 (xlRangeAutoFormatList3)
-test_xlRangeAutoFormatLocalFormat1 (xlRangeAutoFormatLocalFormat1)
-test_xlRangeAutoFormatLocalFormat2 (xlRangeAutoFormatLocalFormat2)
-test_xlRangeAutoFormatLocalFormat3 (xlRangeAutoFormatLocalFormat3)
-test_xlRangeAutoFormatLocalFormat4 (xlRangeAutoFormatLocalFormat4)
-test_xlRangeAutoFormatNone (xlRangeAutoFormatNone)
-test_xlRangeAutoFormatPTNone (xlRangeAutoFormatPTNone)
-test_xlRangeAutoFormatReport1 (xlRangeAutoFormatReport1)
-test_xlRangeAutoFormatReport10 (xlRangeAutoFormatReport10)
-test_xlRangeAutoFormatReport2 (xlRangeAutoFormatReport2)
-test_xlRangeAutoFormatReport3 (xlRangeAutoFormatReport3)
-test_xlRangeAutoFormatReport4 (xlRangeAutoFormatReport4)
-test_xlRangeAutoFormatReport5 (xlRangeAutoFormatReport5)
-test_xlRangeAutoFormatReport6 (xlRangeAutoFormatReport6)
-test_xlRangeAutoFormatReport7 (xlRangeAutoFormatReport7)
-test_xlRangeAutoFormatReport8 (xlRangeAutoFormatReport8)
-test_xlRangeAutoFormatReport9 (xlRangeAutoFormatReport9)
-test_xlRangeAutoFormatSimple (xlRangeAutoFormatSimple)
-test_xlRangeAutoFormatTable1 (xlRangeAutoFormatTable1)
-test_xlRangeAutoFormatTable10 (xlRangeAutoFormatTable10)
-test_xlRangeAutoFormatTable2 (xlRangeAutoFormatTable2)
-test_xlRangeAutoFormatTable3 (xlRangeAutoFormatTable3)
-test_xlRangeAutoFormatTable4 (xlRangeAutoFormatTable4)
-test_xlRangeAutoFormatTable5 (xlRangeAutoFormatTable5)
-test_xlRangeAutoFormatTable6 (xlRangeAutoFormatTable6)
-test_xlRangeAutoFormatTable7 (xlRangeAutoFormatTable7)
-test_xlRangeAutoFormatTable8 (xlRangeAutoFormatTable8)
-test_xlRangeAutoFormatTable9 (xlRangeAutoFormatTable9)
-test_xlRangeValueDefault (xlRangeValueDefault)
-test_xlRangeValueMSPersistXML (xlRangeValueMSPersistXML)
-test_xlRangeValueXMLSpreadsheet (xlRangeValueXMLSpreadsheet)
-test_xlA1 (xlA1)
-test_xlR1C1 (xlR1C1)
-test_xlAbsolute (xlAbsolute)
-test_xlAbsRowRelColumn (xlAbsRowRelColumn)
-test_xlRelative (xlRelative)
-test_xlRelRowAbsColumn (xlRelRowAbsColumn)
-test_xlAlways (xlAlways)
-test_xlAsRequired (xlAsRequired)
-test_xlNever (xlNever)
-test_xlAllAtOnce (xlAllAtOnce)
-test_xlOneAfterAnother (xlOneAfterAnother)
-test_xlNotYetRouted (xlNotYetRouted)
-test_xlRoutingComplete (xlRoutingComplete)
-test_xlRoutingInProgress (xlRoutingInProgress)
-test_xlColumns (xlColumns)
-test_xlRows (xlRows)
-test_xlAutoActivate (xlAutoActivate)
-test_xlAutoClose (xlAutoClose)
-test_xlAutoDeactivate (xlAutoDeactivate)
-test_xlAutoOpen (xlAutoOpen)
-test_xlDoNotSaveChanges (xlDoNotSaveChanges)
-test_xlSaveChanges (xlSaveChanges)
-test_xlExclusive (xlExclusive)
-test_xlNoChange (xlNoChange)
-test_xlShared (xlShared)
-test_xlLocalSessionsChanges (xlLocalSessionsChanges)
-test_xlOtherSessionsChanges (xlOtherSessionsChanges)
-test_xlUserResolution (xlUserResolution)
-test_xlScaleLinear (xlScaleLinear)
-test_xlScaleLogarithmicr (xlScaleLogarithmicr)
-test_xlNext (xlNext)
-test_xlPrevious (xlPrevious)
-test_xlByColumns (xlByColumns)
-test_xlByRows (xlByRows)
-test_xlWithinSheet (xlWithinSheet)
-test_xlWithinWorkbook (xlWithinWorkbook)
-test_xlChart (xlChart)
-test_xlDialogSheet (xlDialogSheet)
-test_xlExcel4IntMacroSheet (xlExcel4IntMacroSheet)
-test_xlExcel4MacroSheet (xlExcel4MacroSheet)
-test_xlWorkSheet (xlWorkSheet)
-test_xlSheetHidden (xlSheetHidden)
-test_xlSheetVeryHidden (xlSheetVeryHidden)
-test_xlSheetVisible (xlSheetVisible)
-test_xlSizeIsArea (xlSizeIsArea)
-test_xlSizeIsWidth (xlSizeIsWidth)
-test_xlSmartTagControlActiveX (xlSmartTagControlActiveX)
-test_xlSmartTagControlButton (xlSmartTagControlButton)
-test_xlSmartTagControlCheckbox (xlSmartTagControlCheckbox)
-test_xlSmartTagControlCombo (xlSmartTagControlCombo)
-test_xlSmartTagControlHelp (xlSmartTagControlHelp)
-test_xlSmartTagControlHelpURL (xlSmartTagControlHelpURL)
-test_xlSmartTagControlImage (xlSmartTagControlImage)
-test_xlSmartTagControlLabel (xlSmartTagControlLabel)
-test_xlSmartTagControlLink (xlSmartTagControlLink)
-test_xlSmartTagControlListbox (xlSmartTagControlListbox)
-test_xlSmartTagControlRadioGroup (xlSmartTagControlRadioGroup)
-test_xlSmartTagControlSeparator (xlSmartTagControlSeparator)
-test_xlSmartTagControlSmartTag (xlSmartTagControlSmartTag)
-test_xlSmartTagControlTextbox (xlSmartTagControlTextbox)
-test_xlButtonOnly (xlButtonOnly)
-test_xlDisplayNone (xlDisplayNone)
-test_xlIndicatorAndButton (xlIndicatorAndButton)
-test_xlSortNormal (xlSortNormal)
-test_xlSortTextAsNumbers (xlSortTextAsNumbers)
-test_xlPinYin (xlPinYin)
-test_xlStroke (xlStroke)
-test_xlCodePage (xlCodePage)
-test_xlSyllabary (xlSyllabary)
-test_xlAscending (xlAscending)
-test_xlDescending (xlDescending)
-test_xlSortColumns (xlSortColumns)
-test_xlSortRows (xlSortRows)
-test_xlSortLabels (xlSortLabels)
-test_xlSortValues (xlSortValues)
-test_xlSourceAutoFilter (xlSourceAutoFilter)
-test_xlSourceChart (xlSourceChart)
-test_xlSourcePivotTable (xlSourcePivotTable)
-test_xlSourcePrintArea (xlSourcePrintArea)
-test_xlSourceQuery (xlSourceQuery)
-test_xlSourceRange (xlSourceRange)
-test_xlSourceSheet (xlSourceSheet)
-test_xlSourceWordbook (xlSourceWordbook)
-test_xlSpeakByColumns (xlSpeakByColumns)
-test_xlSpeakByRows (xlSpeakByRows)
-test_xlErrors (xlErrors)
-test_xlLogical (xlLogical)
-test_xlNumbers (xlNumbers)
-test_xlTextValues (xlTextValues)
-test_xlSubscribeToPicture (xlSubscribeToPicture)
-test_xlSubscribeToText (xlSubscribeToText)
-test_xlAtBottom (xlAtBottom)
-test_xlAtTop (xlAtTop)
-test_xlSummaryOnLeft (xlSummaryOnLeft)
-test_xlSummaryOnRight (xlSummaryOnRight)
-test_xlStandardSummary (xlStandardSummary)
-test_xlSummaryPivotTable (xlSummaryPivotTable)
-test_xlSummaryAbove (xlSummaryAbove)
-test_xlSummaryBelow (xlSummaryBelow)
-test_xlTabPositionFirst (xlTabPositionFirst)
-test_xlTabPositionLast (xlTabPositionLast)
-test_xlDelimited (xlDelimited)
-test_xlFixedWidth (xlFixedWidth)
-test_xlTextQualifierDoubleQuote (xlTextQualifierDoubleQuote)
-test_xlTextQualifierNone (xlTextQualifierNone)
-test_xlTextQualifierSingleQuote (xlTextQualifierSingleQuote)
-test_xlTextVisualLTR (xlTextVisualLTR)
-test_xlTextVisualRTL (xlTextVisualRTL)
-test_XlTickLabelOrientationAutomatic (XlTickLabelOrientationAutomatic)
-test_XlTickLabelOrientationDownward (XlTickLabelOrientationDownward)
-test_XlTickLabelOrientationHorizontal (XlTickLabelOrientationHorizontal)
-test_XlTickLabelOrientationUpward (XlTickLabelOrientationUpward)
-test_XlTickLabelOrientationVertical (XlTickLabelOrientationVertical)
-test_xlTickLabelPositionHigh (xlTickLabelPositionHigh)
-test_xlTickLabelPositionLow (xlTickLabelPositionLow)
-test_xlTickLabelPositionNextToAxis (xlTickLabelPositionNextToAxis)
-test_xlTickLabelPositionNone (xlTickLabelPositionNone)
-test_xlTickMarkCross (xlTickMarkCross)
-test_xlTickMarkInside (xlTickMarkInside)
-test_xlTickMarkNone (xlTickMarkNone)
-test_xlTickMarkOutside (xlTickMarkOutside)
-test_xlDays (xlDays)
-test_xlMonths (xlMonths)
-test_xlYears (xlYears)
-test_xlNoButtonChanges (xlNoButtonChanges)
-test_xlNoChanges (xlNoChanges)
-test_xlNoDockingChanges (xlNoDockingChanges)
-test_xlNoShapeChanges (xlNoShapeChanges)
-test_xlToolbarProtectionNone (xlToolbarProtectionNone)
-test_xlTotalsCalculationAverage (xlTotalsCalculationAverage)
-test_xlTotalsCalculationCount (xlTotalsCalculationCount)
-test_xlTotalsCalculationCountNums (xlTotalsCalculationCountNums)
-test_xlTotalsCalculationCountMax (xlTotalsCalculationCountMax)
-test_xlTotalsCalculationCountMin (xlTotalsCalculationCountMin)
-test_xlTotalsCalculationCountNone (xlTotalsCalculationCountNone)
-test_xlTotalsCalculationCountStdDev (xlTotalsCalculationCountStdDev)
-test_xlTotalsCalculationCountSum (xlTotalsCalculationCountSum)
-test_xlTotalsCalculationCountVar (xlTotalsCalculationCountVar)
-test_xlExponential (xlExponential)
-test_xlLinear (xlLinear)
-test_xlLogarithmic (xlLogarithmic)
-test_xlMovingAvg (xlMovingAvg)
-test_xlPolynomial (xlPolynomial)
-test_xlPower (xlPower)
-test_XlUnderlineStyleDouble (XlUnderlineStyleDouble)
-test_XlUnderlineStyleDoubleAccounting (XlUnderlineStyleDoubleAccounting)
-test_XlUnderlineStyleNone (XlUnderlineStyleNone)
-test_XlUnderlineStyleSingle (XlUnderlineStyleSingle)
-test_XlUnderlineStyleSingleAccounting (XlUnderlineStyleSingleAccounting)
-test_XlUpdateLinksAlways (XlUpdateLinksAlways)
-test_XlUpdateLinksNever (XlUpdateLinksNever)
-test_XlUpdateLinksUserSetting (XlUpdateLinksUserSetting)
-test_xlVAlignBottom (xlVAlignBottom)
-test_xlVAlignCenter (xlVAlignCenter)
-test_xlVAlignDistributed (xlVAlignDistributed)
-test_xlVAlignJustify (xlVAlignJustify)
-test_xlVAlignTop (xlVAlignTop)
-test_XlWBATChart (XlWBATChart)
-test_XlWBATExcel4IntlMacroSheet (XlWBATExcel4IntlMacroSheet)
-test_XlWBATExcel4MacroSheet (XlWBATExcel4MacroSheet)
-test_XlWBATWorksheet (XlWBATWorksheet)
-test_xlWebFormattingAll (xlWebFormattingAll)
-test_xlWebFormattingNone (xlWebFormattingNone)
-test_xlWebFormattingRTF (xlWebFormattingRTF)
-test_xlAllTables (xlAllTables)
-test_xlEntirePage (xlEntirePage)
-test_xlSpecifiedTables (xlSpecifiedTables)
-test_xlMaximized (xlMaximized)
-test_xlMinimized (xlMinimized)
-test_xlNormal (xlNormal)
-test_xlChartAsWindow (xlChartAsWindow)
-test_xlChartInPlace (xlChartInPlace)
-test_xlClipboard (xlClipboard)
-test_xlInfo (xlInfo)
-test_xlWordbook (xlWordbook)
-test_xlNormalView (xlNormalView)
-test_xlPageBreakPreview (xlPageBreakPreview)
-test_xlCommand (xlCommand)
-test_xlFunction (xlFunction)
-test_xlnotXLM (xlnotXLM)
-test_xlXmlExportSuccess (xlXmlExportSuccess)
-test_xlXmlExportValidationFailed (xlXmlExportValidationFailed)
-test_xlXmlImportElementsTruncated (xlXmlImportElementsTruncated)
-test_xlXmlImportSuccess (xlXmlImportSuccess)
-test_xlXmlImportValidationFailed (xlXmlImportValidationFailed)
-test_xlXmlLoadImportToList (xlXmlLoadImportToList)
-test_xlXmlLoadMapXml (xlXmlLoadMapXml)
-test_xlXmlLoadOpenXml (xlXmlLoadOpenXml)
-test_xlXmlLoadPromptUser (xlXmlLoadPromptUser)
-test_xlGuess (xlGuess)
-test_xlNo (xlNo)
-test_xlYes (xlYes)
-Range("A1").Value = "constant name"
-Range("B1").Value = "OOo result"
-Range("C1").Value = "Excel result"
-Range("D1").Value = "Correct?"
-End Sub
-
-Function test_XlEditionFormat(ByRef num)
-Range("A2").Clear
-Range("B2").Clear
-Range("C2").Clear
-Range("D2").Clear
-Range("A2").Value = "XlEditionFormat"
-Range("B2").Value = 0
-Range("C2").Value = num
-B2 = Range("B2").Value
-C2 = Range("C2").Value
-If B2 = C2 Then
-Range("D2").Value = "OK"
-Else
-Range("D2").Value = "NG"
-End If
-End Function
-
-Function test_xlAutomaticUpdate(ByRef num)
-Range("A3").Clear
-Range("B3").Clear
-Range("C3").Clear
-Range("D3").Clear
-Range("A3").Value = "xlAutomaticUpdate"
-Range("B3").Value = 4
-Range("C3").Value = num
-B3 = Range("B3").Value
-C3 = Range("C3").Value
-If B3 = C3 Then
-Range("D3").Value = "OK"
-Else
-Range("D3").Value = "NG"
-End If
-End Function
-
-Function test_xlCancel(ByRef num)
-Range("A4").Clear
-Range("B4").Clear
-Range("C4").Clear
-Range("D4").Clear
-Range("A4").Value = "xlCancel"
-Range("B4").Value = 1
-Range("C4").Value = num
-B4 = Range("B4").Value
-C4 = Range("C4").Value
-If B4 = C4 Then
-Range("D4").Value = "OK"
-Else
-Range("D4").Value = "NG"
-End If
-End Function
-
-Function test_xlChangeAttributes(ByRef num)
-Range("A5").Clear
-Range("B5").Clear
-Range("C5").Clear
-Range("D5").Clear
-Range("A5").Value = "xlChangeAttributes"
-Range("B5").Value = 6
-Range("C5").Value = num
-B5 = Range("B5").Value
-C5 = Range("C5").Value
-If B5 = C5 Then
-Range("D5").Value = "OK"
-Else
-Range("D5").Value = "NG"
-End If
-End Function
-
-Function test_xlManualUpdate(ByRef num)
-Range("A6").Clear
-Range("B6").Clear
-Range("C6").Clear
-Range("D6").Clear
-Range("A6").Value = "xlManualUpdate"
-Range("B6").Value = 5
-Range("C6").Value = num
-B6 = Range("B6").Value
-C6 = Range("C6").Value
-If B6 = C6 Then
-Range("D6").Value = "OK"
-Else
-Range("D6").Value = "NG"
-End If
-End Function
-
-Function test_xlOpenSource(ByRef num)
-Range("A7").Clear
-Range("B7").Clear
-Range("C7").Clear
-Range("D7").Clear
-Range("A7").Value = "xlOpenSource"
-Range("B7").Value = 3
-Range("C7").Value = num
-B7 = Range("B7").Value
-C7 = Range("C7").Value
-If B7 = C7 Then
-Range("D7").Value = "OK"
-Else
-Range("D7").Value = "NG"
-End If
-End Function
-
-Function test_xlSelect(ByRef num)
-Range("A8").Clear
-Range("B8").Clear
-Range("C8").Clear
-Range("D8").Clear
-Range("A8").Value = "xlSelect"
-Range("B8").Value = 3
-Range("C8").Value = num
-B8 = Range("B8").Value
-C8 = Range("C8").Value
-If B8 = C8 Then
-Range("D8").Value = "OK"
-Else
-Range("D8").Value = "NG"
-End If
-End Function
-
-Function test_xlSendPublisher(ByRef num)
-Range("A9").Clear
-Range("B9").Clear
-Range("C9").Clear
-Range("D9").Clear
-Range("A9").Value = "xlSendPublisher"
-Range("B9").Value = 2
-Range("C9").Value = num
-B9 = Range("B9").Value
-C9 = Range("C9").Value
-If B9 = C9 Then
-Range("D9").Value = "OK"
-Else
-Range("D9").Value = "NG"
-End If
-End Function
-
-Function test_xlUpdateSubscriber(ByRef num)
-Range("A10").Clear
-Range("B10").Clear
-Range("C10").Clear
-Range("D10").Clear
-Range("A10").Value = "xlUpdateSubscriber"
-Range("B10").Value = 2
-Range("C10").Value = num
-B10 = Range("B10").Value
-C10 = Range("C10").Value
-If B10 = C10 Then
-Range("D10").Value = "OK"
-Else
-Range("D10").Value = "NG"
-End If
-End Function
-
-Function test_xlPublisher(ByRef num)
-Range("A11").Clear
-Range("B11").Clear
-Range("C11").Clear
-Range("D11").Clear
-Range("A11").Value = "xlPublisher"
-Range("B11").Value = 1
-Range("C11").Value = num
-B11 = Range("B11").Value
-C11 = Range("C11").Value
-If B11 = C11 Then
-Range("D11").Value = "OK"
-Else
-Range("D11").Value = "NG"
-End If
-End Function
-
-Function test_xlSubscriber(ByRef num)
-Range("A12").Clear
-Range("B12").Clear
-Range("C12").Clear
-Range("D12").Clear
-Range("A12").Value = "xlSubscriber"
-Range("B12").Value = 2
-Range("C12").Value = num
-B12 = Range("B12").Value
-C12 = Range("C12").Value
-If B12 = C12 Then
-Range("D12").Value = "OK"
-Else
-Range("D12").Value = "NG"
-End If
-End Function
-
-Function test_xlDisabled(ByRef num)
-Range("A13").Clear
-Range("B13").Clear
-Range("C13").Clear
-Range("D13").Clear
-Range("A13").Value = "xlDisabled"
-Range("B13").Value = 0
-Range("C13").Value = num
-B13 = Range("B13").Value
-C13 = Range("C13").Value
-If B13 = C13 Then
-Range("D13").Value = "OK"
-Else
-Range("D13").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorHandler(ByRef num)
-Range("A14").Clear
-Range("B14").Clear
-Range("C14").Clear
-Range("D14").Clear
-Range("A14").Value = "xlErrorHandler"
-Range("B14").Value = 2
-Range("C14").Value = num
-B14 = Range("B14").Value
-C14 = Range("C14").Value
-If B14 = C14 Then
-Range("D14").Value = "OK"
-Else
-Range("D14").Value = "NG"
-End If
-End Function
-
-Function test_xlInterrupt(ByRef num)
-Range("A15").Clear
-Range("B15").Clear
-Range("C15").Clear
-Range("D15").Clear
-Range("A15").Value = "xlInterrupt"
-Range("B15").Value = 1
-Range("C15").Value = num
-B15 = Range("B15").Value
-C15 = Range("C15").Value
-If B15 = C15 Then
-Range("D15").Value = "OK"
-Else
-Range("D15").Value = "NG"
-End If
-End Function
-
-Function test_xlNoRestrictions(ByRef num)
-Range("A16").Clear
-Range("B16").Clear
-Range("C16").Clear
-Range("D16").Clear
-Range("A16").Value = "xlNoRestrictions"
-Range("B16").Value = 0
-Range("C16").Value = num
-B16 = Range("B16").Value
-C16 = Range("C16").Value
-If B16 = C16 Then
-Range("D16").Value = "OK"
-Else
-Range("D16").Value = "NG"
-End If
-End Function
-
-Function test_xlNoSelection(ByRef num)
-Range("A17").Clear
-Range("B17").Clear
-Range("C17").Clear
-Range("D17").Clear
-Range("A17").Value = "xlNoSelection"
-Range("B17").Value = -4142
-Range("C17").Value = num
-B17 = Range("B17").Value
-C17 = Range("C17").Value
-If B17 = C17 Then
-Range("D17").Value = "OK"
-Else
-Range("D17").Value = "NG"
-End If
-End Function
-
-Function test_xlUnlockedCells(ByRef num)
-Range("A18").Clear
-Range("B18").Clear
-Range("C18").Clear
-Range("D18").Clear
-Range("A18").Value = "xlUnlockedCells"
-Range("B18").Value = 1
-Range("C18").Value = num
-B18 = Range("B18").Value
-C18 = Range("C18").Value
-If B18 = C18 Then
-Range("D18").Value = "OK"
-Else
-Range("D18").Value = "NG"
-End If
-End Function
-
-Function test_xlCap(ByRef num)
-Range("A19").Clear
-Range("B19").Clear
-Range("C19").Clear
-Range("D19").Clear
-Range("A19").Value = "xlCap"
-Range("B19").Value = 1
-Range("C19").Value = num
-B19 = Range("B19").Value
-C19 = Range("C19").Value
-If B19 = C19 Then
-Range("D19").Value = "OK"
-Else
-Range("D19").Value = "NG"
-End If
-End Function
-
-Function test_xlNoCap(ByRef num)
-Range("A20").Clear
-Range("B20").Clear
-Range("C20").Clear
-Range("D20").Clear
-Range("A20").Value = "xlNoCap"
-Range("B20").Value = 2
-Range("C20").Value = num
-B20 = Range("B20").Value
-C20 = Range("C20").Value
-If B20 = C20 Then
-Range("D20").Value = "OK"
-Else
-Range("D20").Value = "NG"
-End If
-End Function
-
-Function test_xlX(ByRef num)
-Range("A21").Clear
-Range("B21").Clear
-Range("C21").Clear
-Range("D21").Clear
-Range("A21").Value = "xlX"
-Range("B21").Value = -4168
-Range("C21").Value = num
-B21 = Range("B21").Value
-C21 = Range("C21").Value
-If B21 = C21 Then
-Range("D21").Value = "OK"
-Else
-Range("D21").Value = "NG"
-End If
-End Function
-
-Function test_xlY(ByRef num)
-Range("A22").Clear
-Range("B22").Clear
-Range("C22").Clear
-Range("D22").Clear
-Range("A22").Value = "xlY"
-Range("B22").Value = 1
-Range("C22").Value = num
-B22 = Range("B22").Value
-C22 = Range("C22").Value
-If B22 = C22 Then
-Range("D22").Value = "OK"
-Else
-Range("D22").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarIncludeBoth(ByRef num)
-Range("A23").Clear
-Range("B23").Clear
-Range("C23").Clear
-Range("D23").Clear
-Range("A23").Value = "xlErrorBarIncludeBoth"
-Range("B23").Value = 1
-Range("C23").Value = num
-B23 = Range("B23").Value
-C23 = Range("C23").Value
-If B23 = C23 Then
-Range("D23").Value = "OK"
-Else
-Range("D23").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarIncludeMinusValues(ByRef num)
-Range("A24").Clear
-Range("B24").Clear
-Range("C24").Clear
-Range("D24").Clear
-Range("A24").Value = "xlErrorBarIncludeMinusValues"
-Range("B24").Value = 3
-Range("C24").Value = num
-B24 = Range("B24").Value
-C24 = Range("C24").Value
-If B24 = C24 Then
-Range("D24").Value = "OK"
-Else
-Range("D24").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarIncludeNone(ByRef num)
-Range("A25").Clear
-Range("B25").Clear
-Range("C25").Clear
-Range("D25").Clear
-Range("A25").Value = "xlErrorBarIncludeNone"
-Range("B25").Value = -4142
-Range("C25").Value = num
-B25 = Range("B25").Value
-C25 = Range("C25").Value
-If B25 = C25 Then
-Range("D25").Value = "OK"
-Else
-Range("D25").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarIncludePlusValues(ByRef num)
-Range("A26").Clear
-Range("B26").Clear
-Range("C26").Clear
-Range("D26").Clear
-Range("A26").Value = "xlErrorBarIncludePlusValues"
-Range("B26").Value = 2
-Range("C26").Value = num
-B26 = Range("B26").Value
-C26 = Range("C26").Value
-If B26 = C26 Then
-Range("D26").Value = "OK"
-Else
-Range("D26").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarTypeCustom(ByRef num)
-Range("A27").Clear
-Range("B27").Clear
-Range("C27").Clear
-Range("D27").Clear
-Range("A27").Value = "xlErrorBarTypeCustom"
-Range("B27").Value = -4144
-Range("C27").Value = num
-B27 = Range("B27").Value
-C27 = Range("C27").Value
-If B27 = C27 Then
-Range("D27").Value = "OK"
-Else
-Range("D27").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarTypeFixedValue(ByRef num)
-Range("A28").Clear
-Range("B28").Clear
-Range("C28").Clear
-Range("D28").Clear
-Range("A28").Value = "xlErrorBarTypeFixedValue"
-Range("B28").Value = 1
-Range("C28").Value = num
-B28 = Range("B28").Value
-C28 = Range("C28").Value
-If B28 = C28 Then
-Range("D28").Value = "OK"
-Else
-Range("D28").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarTypePercent(ByRef num)
-Range("A29").Clear
-Range("B29").Clear
-Range("C29").Clear
-Range("D29").Clear
-Range("A29").Value = "xlErrorBarTypePercent"
-Range("B29").Value = 2
-Range("C29").Value = num
-B29 = Range("B29").Value
-C29 = Range("C29").Value
-If B29 = C29 Then
-Range("D29").Value = "OK"
-Else
-Range("D29").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarTypeStDev(ByRef num)
-Range("A30").Clear
-Range("B30").Clear
-Range("C30").Clear
-Range("D30").Clear
-Range("A30").Value = "xlErrorBarTypeStDev"
-Range("B30").Value = -4155
-Range("C30").Value = num
-B30 = Range("B30").Value
-C30 = Range("C30").Value
-If B30 = C30 Then
-Range("D30").Value = "OK"
-Else
-Range("D30").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarTypeStError(ByRef num)
-Range("A31").Clear
-Range("B31").Clear
-Range("C31").Clear
-Range("D31").Clear
-Range("A31").Value = "xlErrorBarTypeStError"
-Range("B31").Value = 4
-Range("C31").Value = num
-B31 = Range("B31").Value
-C31 = Range("C31").Value
-If B31 = C31 Then
-Range("D31").Value = "OK"
-Else
-Range("D31").Value = "NG"
-End If
-End Function
-
-Function test_xlEmptyCellReferences(ByRef num)
-Range("A32").Clear
-Range("B32").Clear
-Range("C32").Clear
-Range("D32").Clear
-Range("A32").Value = "xlEmptyCellReferences"
-Range("B32").Value = 7
-Range("C32").Value = num
-B32 = Range("B32").Value
-C32 = Range("C32").Value
-If B32 = C32 Then
-Range("D32").Value = "OK"
-Else
-Range("D32").Value = "NG"
-End If
-End Function
-
-Function test_xlEvaluateToError(ByRef num)
-Range("A33").Clear
-Range("B33").Clear
-Range("C33").Clear
-Range("D33").Clear
-Range("A33").Value = "xlEvaluateToError"
-Range("B33").Value = 1
-Range("C33").Value = num
-B33 = Range("B33").Value
-C33 = Range("C33").Value
-If B33 = C33 Then
-Range("D33").Value = "OK"
-Else
-Range("D33").Value = "NG"
-End If
-End Function
-
-Function test_xlInconsistentFormula(ByRef num)
-Range("A34").Clear
-Range("B34").Clear
-Range("C34").Clear
-Range("D34").Clear
-Range("A34").Value = "xlInconsistentFormula"
-Range("B34").Value = 4
-Range("C34").Value = num
-B34 = Range("B34").Value
-C34 = Range("C34").Value
-If B34 = C34 Then
-Range("D34").Value = "OK"
-Else
-Range("D34").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataValidation(ByRef num)
-Range("A35").Clear
-Range("B35").Clear
-Range("C35").Clear
-Range("D35").Clear
-Range("A35").Value = "xlListDataValidation"
-Range("B35").Value = 8
-Range("C35").Value = num
-B35 = Range("B35").Value
-C35 = Range("C35").Value
-If B35 = C35 Then
-Range("D35").Value = "OK"
-Else
-Range("D35").Value = "NG"
-End If
-End Function
-
-Function test_xlNumberAsText(ByRef num)
-Range("A36").Clear
-Range("B36").Clear
-Range("C36").Clear
-Range("D36").Clear
-Range("A36").Value = "xlNumberAsText"
-Range("B36").Value = 3
-Range("C36").Value = num
-B36 = Range("B36").Value
-C36 = Range("C36").Value
-If B36 = C36 Then
-Range("D36").Value = "OK"
-Else
-Range("D36").Value = "NG"
-End If
-End Function
-
-Function test_xlOmittedCells(ByRef num)
-Range("A37").Clear
-Range("B37").Clear
-Range("C37").Clear
-Range("D37").Clear
-Range("A37").Value = "xlOmittedCells"
-Range("B37").Value = 5
-Range("C37").Value = num
-B37 = Range("B37").Value
-C37 = Range("C37").Value
-If B37 = C37 Then
-Range("D37").Value = "OK"
-Else
-Range("D37").Value = "NG"
-End If
-End Function
-
-Function test_xlTextDate(ByRef num)
-Range("A38").Clear
-Range("B38").Clear
-Range("C38").Clear
-Range("D38").Clear
-Range("A38").Value = "xlTextDate"
-Range("B38").Value = 2
-Range("C38").Value = num
-B38 = Range("B38").Value
-C38 = Range("C38").Value
-If B38 = C38 Then
-Range("D38").Value = "OK"
-Else
-Range("D38").Value = "NG"
-End If
-End Function
-
-Function test_xlUnlockedFormulaCells(ByRef num)
-Range("A39").Clear
-Range("B39").Clear
-Range("C39").Clear
-Range("D39").Clear
-Range("A39").Value = "xlUnlockedFormulaCells"
-Range("B39").Value = 6
-Range("C39").Value = num
-B39 = Range("B39").Value
-C39 = Range("C39").Value
-If B39 = C39 Then
-Range("D39").Value = "OK"
-Else
-Range("D39").Value = "NG"
-End If
-End Function
-
-Function test_xlReadOnly(ByRef num)
-Range("A40").Clear
-Range("B40").Clear
-Range("C40").Clear
-Range("D40").Clear
-Range("A40").Value = "xlReadOnly"
-Range("B40").Value = 3
-Range("C40").Value = num
-B40 = Range("B40").Value
-C40 = Range("C40").Value
-If B40 = C40 Then
-Range("D40").Value = "OK"
-Else
-Range("D40").Value = "NG"
-End If
-End Function
-
-Function test_xlReadWrite(ByRef num)
-Range("A41").Clear
-Range("B41").Clear
-Range("C41").Clear
-Range("D41").Clear
-Range("A41").Value = "xlReadWrite"
-Range("B41").Value = 2
-Range("C41").Value = num
-B41 = Range("B41").Value
-C41 = Range("C41").Value
-If B41 = C41 Then
-Range("D41").Value = "OK"
-Else
-Range("D41").Value = "NG"
-End If
-End Function
-
-Function test_xlAddIn(ByRef num)
-Range("A42").Clear
-Range("B42").Clear
-Range("C42").Clear
-Range("D42").Clear
-Range("A42").Value = "xlAddIn"
-Range("B42").Value = 18
-Range("C42").Value = num
-B42 = Range("B42").Value
-C42 = Range("C42").Value
-If B42 = C42 Then
-Range("D42").Value = "OK"
-Else
-Range("D42").Value = "NG"
-End If
-End Function
-
-Function test_xlCSV(ByRef num)
-Range("A43").Clear
-Range("B43").Clear
-Range("C43").Clear
-Range("D43").Clear
-Range("A43").Value = "xlCSV"
-Range("B43").Value = 6
-Range("C43").Value = num
-B43 = Range("B43").Value
-C43 = Range("C43").Value
-If B43 = C43 Then
-Range("D43").Value = "OK"
-Else
-Range("D43").Value = "NG"
-End If
-End Function
-
-Function test_xlCSVMac(ByRef num)
-Range("A44").Clear
-Range("B44").Clear
-Range("C44").Clear
-Range("D44").Clear
-Range("A44").Value = "xlCSVMac"
-Range("B44").Value = 22
-Range("C44").Value = num
-B44 = Range("B44").Value
-C44 = Range("C44").Value
-If B44 = C44 Then
-Range("D44").Value = "OK"
-Else
-Range("D44").Value = "NG"
-End If
-End Function
-
-Function test_xlCSVMSDOS(ByRef num)
-Range("A45").Clear
-Range("B45").Clear
-Range("C45").Clear
-Range("D45").Clear
-Range("A45").Value = "xlCSVMSDOS"
-Range("B45").Value = 24
-Range("C45").Value = num
-B45 = Range("B45").Value
-C45 = Range("C45").Value
-If B45 = C45 Then
-Range("D45").Value = "OK"
-Else
-Range("D45").Value = "NG"
-End If
-End Function
-
-Function test_xlCSVWindows(ByRef num)
-Range("A46").Clear
-Range("B46").Clear
-Range("C46").Clear
-Range("D46").Clear
-Range("A46").Value = "xlCSVWindows"
-Range("B46").Value = 23
-Range("C46").Value = num
-B46 = Range("B46").Value
-C46 = Range("C46").Value
-If B46 = C46 Then
-Range("D46").Value = "OK"
-Else
-Range("D46").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrentPlatformText(ByRef num)
-Range("A47").Clear
-Range("B47").Clear
-Range("C47").Clear
-Range("D47").Clear
-Range("A47").Value = "xlCurrentPlatformText"
-Range("B47").Value = -4158
-Range("C47").Value = num
-B47 = Range("B47").Value
-C47 = Range("C47").Value
-If B47 = C47 Then
-Range("D47").Value = "OK"
-Else
-Range("D47").Value = "NG"
-End If
-End Function
-
-Function test_xlDBF2(ByRef num)
-Range("A48").Clear
-Range("B48").Clear
-Range("C48").Clear
-Range("D48").Clear
-Range("A48").Value = "xlDBF2"
-Range("B48").Value = 7
-Range("C48").Value = num
-B48 = Range("B48").Value
-C48 = Range("C48").Value
-If B48 = C48 Then
-Range("D48").Value = "OK"
-Else
-Range("D48").Value = "NG"
-End If
-End Function
-
-Function test_xlDBF3(ByRef num)
-Range("A49").Clear
-Range("B49").Clear
-Range("C49").Clear
-Range("D49").Clear
-Range("A49").Value = "xlDBF3"
-Range("B49").Value = 8
-Range("C49").Value = num
-B49 = Range("B49").Value
-C49 = Range("C49").Value
-If B49 = C49 Then
-Range("D49").Value = "OK"
-Else
-Range("D49").Value = "NG"
-End If
-End Function
-
-Function test_xlDBF4(ByRef num)
-Range("A50").Clear
-Range("B50").Clear
-Range("C50").Clear
-Range("D50").Clear
-Range("A50").Value = "xlDBF4"
-Range("B50").Value = 11
-Range("C50").Value = num
-B50 = Range("B50").Value
-C50 = Range("C50").Value
-If B50 = C50 Then
-Range("D50").Value = "OK"
-Else
-Range("D50").Value = "NG"
-End If
-End Function
-
-Function test_xlDIF(ByRef num)
-Range("A51").Clear
-Range("B51").Clear
-Range("C51").Clear
-Range("D51").Clear
-Range("A51").Value = "xlDIF"
-Range("B51").Value = 9
-Range("C51").Value = num
-B51 = Range("B51").Value
-C51 = Range("C51").Value
-If B51 = C51 Then
-Range("D51").Value = "OK"
-Else
-Range("D51").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel2(ByRef num)
-Range("A52").Clear
-Range("B52").Clear
-Range("C52").Clear
-Range("D52").Clear
-Range("A52").Value = "xlExcel2"
-Range("B52").Value = 16
-Range("C52").Value = num
-B52 = Range("B52").Value
-C52 = Range("C52").Value
-If B52 = C52 Then
-Range("D52").Value = "OK"
-Else
-Range("D52").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel2FarEast(ByRef num)
-Range("A53").Clear
-Range("B53").Clear
-Range("C53").Clear
-Range("D53").Clear
-Range("A53").Value = "xlExcel2FarEast"
-Range("B53").Value = 27
-Range("C53").Value = num
-B53 = Range("B53").Value
-C53 = Range("C53").Value
-If B53 = C53 Then
-Range("D53").Value = "OK"
-Else
-Range("D53").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel3(ByRef num)
-Range("A54").Clear
-Range("B54").Clear
-Range("C54").Clear
-Range("D54").Clear
-Range("A54").Value = "xlExcel3"
-Range("B54").Value = 29
-Range("C54").Value = num
-B54 = Range("B54").Value
-C54 = Range("C54").Value
-If B54 = C54 Then
-Range("D54").Value = "OK"
-Else
-Range("D54").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel4(ByRef num)
-Range("A55").Clear
-Range("B55").Clear
-Range("C55").Clear
-Range("D55").Clear
-Range("A55").Value = "xlExcel4"
-Range("B55").Value = 33
-Range("C55").Value = num
-B55 = Range("B55").Value
-C55 = Range("C55").Value
-If B55 = C55 Then
-Range("D55").Value = "OK"
-Else
-Range("D55").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel4Wordbook(ByRef num)
-Range("A56").Clear
-Range("B56").Clear
-Range("C56").Clear
-Range("D56").Clear
-Range("A56").Value = "xlExcel4Wordbook"
-Range("B56").Value = 35
-Range("C56").Value = num
-B56 = Range("B56").Value
-C56 = Range("C56").Value
-If B56 = C56 Then
-Range("D56").Value = "OK"
-Else
-Range("D56").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel5(ByRef num)
-Range("A57").Clear
-Range("B57").Clear
-Range("C57").Clear
-Range("D57").Clear
-Range("A57").Value = "xlExcel5"
-Range("B57").Value = 39
-Range("C57").Value = num
-B57 = Range("B57").Value
-C57 = Range("C57").Value
-If B57 = C57 Then
-Range("D57").Value = "OK"
-Else
-Range("D57").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel7(ByRef num)
-Range("A58").Clear
-Range("B58").Clear
-Range("C58").Clear
-Range("D58").Clear
-Range("A58").Value = "xlExcel7"
-Range("B58").Value = 39
-Range("C58").Value = num
-B58 = Range("B58").Value
-C58 = Range("C58").Value
-If B58 = C58 Then
-Range("D58").Value = "OK"
-Else
-Range("D58").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel9795(ByRef num)
-Range("A59").Clear
-Range("B59").Clear
-Range("C59").Clear
-Range("D59").Clear
-Range("A59").Value = "xlExcel9795"
-Range("B59").Value = 43
-Range("C59").Value = num
-B59 = Range("B59").Value
-C59 = Range("C59").Value
-If B59 = C59 Then
-Range("D59").Value = "OK"
-Else
-Range("D59").Value = "NG"
-End If
-End Function
-
-Function test_xlHtml(ByRef num)
-Range("A60").Clear
-Range("B60").Clear
-Range("C60").Clear
-Range("D60").Clear
-Range("A60").Value = "xlHtml"
-Range("B60").Value = 44
-Range("C60").Value = num
-B60 = Range("B60").Value
-C60 = Range("C60").Value
-If B60 = C60 Then
-Range("D60").Value = "OK"
-Else
-Range("D60").Value = "NG"
-End If
-End Function
-
-Function test_xlIntlAddIn(ByRef num)
-Range("A61").Clear
-Range("B61").Clear
-Range("C61").Clear
-Range("D61").Clear
-Range("A61").Value = "xlIntlAddIn"
-Range("B61").Value = 26
-Range("C61").Value = num
-B61 = Range("B61").Value
-C61 = Range("C61").Value
-If B61 = C61 Then
-Range("D61").Value = "OK"
-Else
-Range("D61").Value = "NG"
-End If
-End Function
-
-Function test_xlIntlMacro(ByRef num)
-Range("A62").Clear
-Range("B62").Clear
-Range("C62").Clear
-Range("D62").Clear
-Range("A62").Value = "xlIntlMacro"
-Range("B62").Value = 25
-Range("C62").Value = num
-B62 = Range("B62").Value
-C62 = Range("C62").Value
-If B62 = C62 Then
-Range("D62").Value = "OK"
-Else
-Range("D62").Value = "NG"
-End If
-End Function
-
-Function test_xlSYLK(ByRef num)
-Range("A63").Clear
-Range("B63").Clear
-Range("C63").Clear
-Range("D63").Clear
-Range("A63").Value = "xlSYLK"
-Range("B63").Value = 2
-Range("C63").Value = num
-B63 = Range("B63").Value
-C63 = Range("C63").Value
-If B63 = C63 Then
-Range("D63").Value = "OK"
-Else
-Range("D63").Value = "NG"
-End If
-End Function
-
-Function test_xlTemplate(ByRef num)
-Range("A64").Clear
-Range("B64").Clear
-Range("C64").Clear
-Range("D64").Clear
-Range("A64").Value = "xlTemplate"
-Range("B64").Value = 17
-Range("C64").Value = num
-B64 = Range("B64").Value
-C64 = Range("C64").Value
-If B64 = C64 Then
-Range("D64").Value = "OK"
-Else
-Range("D64").Value = "NG"
-End If
-End Function
-
-Function test_xlTextMac(ByRef num)
-Range("A65").Clear
-Range("B65").Clear
-Range("C65").Clear
-Range("D65").Clear
-Range("A65").Value = "xlTextMac"
-Range("B65").Value = 19
-Range("C65").Value = num
-B65 = Range("B65").Value
-C65 = Range("C65").Value
-If B65 = C65 Then
-Range("D65").Value = "OK"
-Else
-Range("D65").Value = "NG"
-End If
-End Function
-
-Function test_xlTextMSDOS(ByRef num)
-Range("A66").Clear
-Range("B66").Clear
-Range("C66").Clear
-Range("D66").Clear
-Range("A66").Value = "xlTextMSDOS"
-Range("B66").Value = 21
-Range("C66").Value = num
-B66 = Range("B66").Value
-C66 = Range("C66").Value
-If B66 = C66 Then
-Range("D66").Value = "OK"
-Else
-Range("D66").Value = "NG"
-End If
-End Function
-
-Function test_xlTextPrinter(ByRef num)
-Range("A67").Clear
-Range("B67").Clear
-Range("C67").Clear
-Range("D67").Clear
-Range("A67").Value = "xlTextPrinter"
-Range("B67").Value = 36
-Range("C67").Value = num
-B67 = Range("B67").Value
-C67 = Range("C67").Value
-If B67 = C67 Then
-Range("D67").Value = "OK"
-Else
-Range("D67").Value = "NG"
-End If
-End Function
-
-Function test_xlTextWindows(ByRef num)
-Range("A68").Clear
-Range("B68").Clear
-Range("C68").Clear
-Range("D68").Clear
-Range("A68").Value = "xlTextWindows"
-Range("B68").Value = 20
-Range("C68").Value = num
-B68 = Range("B68").Value
-C68 = Range("C68").Value
-If B68 = C68 Then
-Range("D68").Value = "OK"
-Else
-Range("D68").Value = "NG"
-End If
-End Function
-
-Function test_xlUnicodeText(ByRef num)
-Range("A69").Clear
-Range("B69").Clear
-Range("C69").Clear
-Range("D69").Clear
-Range("A69").Value = "xlUnicodeText"
-Range("B69").Value = 42
-Range("C69").Value = num
-B69 = Range("B69").Value
-C69 = Range("C69").Value
-If B69 = C69 Then
-Range("D69").Value = "OK"
-Else
-Range("D69").Value = "NG"
-End If
-End Function
-
-Function test_xlWebArchive(ByRef num)
-Range("A70").Clear
-Range("B70").Clear
-Range("C70").Clear
-Range("D70").Clear
-Range("A70").Value = "xlWebArchive"
-Range("B70").Value = 45
-Range("C70").Value = num
-B70 = Range("B70").Value
-C70 = Range("C70").Value
-If B70 = C70 Then
-Range("D70").Value = "OK"
-Else
-Range("D70").Value = "NG"
-End If
-End Function
-
-Function test_xlWJ2WD1(ByRef num)
-Range("A71").Clear
-Range("B71").Clear
-Range("C71").Clear
-Range("D71").Clear
-Range("A71").Value = "xlWJ2WD1"
-Range("B71").Value = 14
-Range("C71").Value = num
-B71 = Range("B71").Value
-C71 = Range("C71").Value
-If B71 = C71 Then
-Range("D71").Value = "OK"
-Else
-Range("D71").Value = "NG"
-End If
-End Function
-
-Function test_xlWJ3(ByRef num)
-Range("A72").Clear
-Range("B72").Clear
-Range("C72").Clear
-Range("D72").Clear
-Range("A72").Value = "xlWJ3"
-Range("B72").Value = 40
-Range("C72").Value = num
-B72 = Range("B72").Value
-C72 = Range("C72").Value
-If B72 = C72 Then
-Range("D72").Value = "OK"
-Else
-Range("D72").Value = "NG"
-End If
-End Function
-
-Function test_xlWJ3FJ3(ByRef num)
-Range("A73").Clear
-Range("B73").Clear
-Range("C73").Clear
-Range("D73").Clear
-Range("A73").Value = "xlWJ3FJ3"
-Range("B73").Value = 41
-Range("C73").Value = num
-B73 = Range("B73").Value
-C73 = Range("C73").Value
-If B73 = C73 Then
-Range("D73").Value = "OK"
-Else
-Range("D73").Value = "NG"
-End If
-End Function
-
-Function test_xlWK1(ByRef num)
-Range("A74").Clear
-Range("B74").Clear
-Range("C74").Clear
-Range("D74").Clear
-Range("A74").Value = "xlWK1"
-Range("B74").Value = 5
-Range("C74").Value = num
-B74 = Range("B74").Value
-C74 = Range("C74").Value
-If B74 = C74 Then
-Range("D74").Value = "OK"
-Else
-Range("D74").Value = "NG"
-End If
-End Function
-
-Function test_xlWK1ALL(ByRef num)
-Range("A75").Clear
-Range("B75").Clear
-Range("C75").Clear
-Range("D75").Clear
-Range("A75").Value = "xlWK1ALL"
-Range("B75").Value = 31
-Range("C75").Value = num
-B75 = Range("B75").Value
-C75 = Range("C75").Value
-If B75 = C75 Then
-Range("D75").Value = "OK"
-Else
-Range("D75").Value = "NG"
-End If
-End Function
-
-Function test_xlWK1FMT(ByRef num)
-Range("A76").Clear
-Range("B76").Clear
-Range("C76").Clear
-Range("D76").Clear
-Range("A76").Value = "xlWK1FMT"
-Range("B76").Value = 30
-Range("C76").Value = num
-B76 = Range("B76").Value
-C76 = Range("C76").Value
-If B76 = C76 Then
-Range("D76").Value = "OK"
-Else
-Range("D76").Value = "NG"
-End If
-End Function
-
-Function test_xlWK3(ByRef num)
-Range("A77").Clear
-Range("B77").Clear
-Range("C77").Clear
-Range("D77").Clear
-Range("A77").Value = "xlWK3"
-Range("B77").Value = 15
-Range("C77").Value = num
-B77 = Range("B77").Value
-C77 = Range("C77").Value
-If B77 = C77 Then
-Range("D77").Value = "OK"
-Else
-Range("D77").Value = "NG"
-End If
-End Function
-
-Function test_xlWK3FM3(ByRef num)
-Range("A78").Clear
-Range("B78").Clear
-Range("C78").Clear
-Range("D78").Clear
-Range("A78").Value = "xlWK3FM3"
-Range("B78").Value = 32
-Range("C78").Value = num
-B78 = Range("B78").Value
-C78 = Range("C78").Value
-If B78 = C78 Then
-Range("D78").Value = "OK"
-Else
-Range("D78").Value = "NG"
-End If
-End Function
-
-Function test_xlWK4(ByRef num)
-Range("A79").Clear
-Range("B79").Clear
-Range("C79").Clear
-Range("D79").Clear
-Range("A79").Value = "xlWK4"
-Range("B79").Value = 38
-Range("C79").Value = num
-B79 = Range("B79").Value
-C79 = Range("C79").Value
-If B79 = C79 Then
-Range("D79").Value = "OK"
-Else
-Range("D79").Value = "NG"
-End If
-End Function
-
-Function test_xlWKS(ByRef num)
-Range("A80").Clear
-Range("B80").Clear
-Range("C80").Clear
-Range("D80").Clear
-Range("A80").Value = "xlWKS"
-Range("B80").Value = 4
-Range("C80").Value = num
-B80 = Range("B80").Value
-C80 = Range("C80").Value
-If B80 = C80 Then
-Range("D80").Value = "OK"
-Else
-Range("D80").Value = "NG"
-End If
-End Function
-
-Function test_xlWordbookNormal(ByRef num)
-Range("A81").Clear
-Range("B81").Clear
-Range("C81").Clear
-Range("D81").Clear
-Range("A81").Value = "xlWordbookNormal"
-Range("B81").Value = -4143
-Range("C81").Value = num
-B81 = Range("B81").Value
-C81 = Range("C81").Value
-If B81 = C81 Then
-Range("D81").Value = "OK"
-Else
-Range("D81").Value = "NG"
-End If
-End Function
-
-Function test_xlWords2FarEast(ByRef num)
-Range("A82").Clear
-Range("B82").Clear
-Range("C82").Clear
-Range("D82").Clear
-Range("A82").Value = "xlWords2FarEast"
-Range("B82").Value = 28
-Range("C82").Value = num
-B82 = Range("B82").Value
-C82 = Range("C82").Value
-If B82 = C82 Then
-Range("D82").Value = "OK"
-Else
-Range("D82").Value = "NG"
-End If
-End Function
-
-Function test_xlWQ1(ByRef num)
-Range("A83").Clear
-Range("B83").Clear
-Range("C83").Clear
-Range("D83").Clear
-Range("A83").Value = "xlWQ1"
-Range("B83").Value = 34
-Range("C83").Value = num
-B83 = Range("B83").Value
-C83 = Range("C83").Value
-If B83 = C83 Then
-Range("D83").Value = "OK"
-Else
-Range("D83").Value = "NG"
-End If
-End Function
-
-Function test_xlXMLSpredsheet(ByRef num)
-Range("A84").Clear
-Range("B84").Clear
-Range("C84").Clear
-Range("D84").Clear
-Range("A84").Value = "xlXMLSpredsheet"
-Range("B84").Value = 46
-Range("C84").Value = num
-B84 = Range("B84").Value
-C84 = Range("C84").Value
-If B84 = C84 Then
-Range("D84").Value = "OK"
-Else
-Range("D84").Value = "NG"
-End If
-End Function
-
-Function test_xlFillWithAll(ByRef num)
-Range("A85").Clear
-Range("B85").Clear
-Range("C85").Clear
-Range("D85").Clear
-Range("A85").Value = "xlFillWithAll"
-Range("B85").Value = -4104
-Range("C85").Value = num
-B85 = Range("B85").Value
-C85 = Range("C85").Value
-If B85 = C85 Then
-Range("D85").Value = "OK"
-Else
-Range("D85").Value = "NG"
-End If
-End Function
-
-Function test_xlFillWithContents(ByRef num)
-Range("A86").Clear
-Range("B86").Clear
-Range("C86").Clear
-Range("D86").Clear
-Range("A86").Value = "xlFillWithContents"
-Range("B86").Value = 2
-Range("C86").Value = num
-B86 = Range("B86").Value
-C86 = Range("C86").Value
-If B86 = C86 Then
-Range("D86").Value = "OK"
-Else
-Range("D86").Value = "NG"
-End If
-End Function
-
-Function test_xlFillWithFormats(ByRef num)
-Range("A87").Clear
-Range("B87").Clear
-Range("C87").Clear
-Range("D87").Clear
-Range("A87").Value = "xlFillWithFormats"
-Range("B87").Value = -4122
-Range("C87").Value = num
-B87 = Range("B87").Value
-C87 = Range("C87").Value
-If B87 = C87 Then
-Range("D87").Value = "OK"
-Else
-Range("D87").Value = "NG"
-End If
-End Function
-
-Function test_xlFilterCopy(ByRef num)
-Range("A88").Clear
-Range("B88").Clear
-Range("C88").Clear
-Range("D88").Clear
-Range("A88").Value = "xlFilterCopy"
-Range("B88").Value = 2
-Range("C88").Value = num
-B88 = Range("B88").Value
-C88 = Range("C88").Value
-If B88 = C88 Then
-Range("D88").Value = "OK"
-Else
-Range("D88").Value = "NG"
-End If
-End Function
-
-Function test_xlFilterInPlace(ByRef num)
-Range("A89").Clear
-Range("B89").Clear
-Range("C89").Clear
-Range("D89").Clear
-Range("A89").Value = "xlFilterInPlace"
-Range("B89").Value = 1
-Range("C89").Value = num
-B89 = Range("B89").Value
-C89 = Range("C89").Value
-If B89 = C89 Then
-Range("D89").Value = "OK"
-Else
-Range("D89").Value = "NG"
-End If
-End Function
-
-Function test_xlComments(ByRef num)
-Range("A90").Clear
-Range("B90").Clear
-Range("C90").Clear
-Range("D90").Clear
-Range("A90").Value = "xlComments"
-Range("B90").Value = -4144
-Range("C90").Value = num
-B90 = Range("B90").Value
-C90 = Range("C90").Value
-If B90 = C90 Then
-Range("D90").Value = "OK"
-Else
-Range("D90").Value = "NG"
-End If
-End Function
-
-Function test_xlFormulas(ByRef num)
-Range("A91").Clear
-Range("B91").Clear
-Range("C91").Clear
-Range("D91").Clear
-Range("A91").Value = "xlFormulas"
-Range("B91").Value = -4123
-Range("C91").Value = num
-B91 = Range("B91").Value
-C91 = Range("C91").Value
-If B91 = C91 Then
-Range("D91").Value = "OK"
-Else
-Range("D91").Value = "NG"
-End If
-End Function
-
-Function test_xlValues(ByRef num)
-Range("A92").Clear
-Range("B92").Clear
-Range("C92").Clear
-Range("D92").Clear
-Range("A92").Value = "xlValues"
-Range("B92").Value = -4163
-Range("C92").Value = num
-B92 = Range("B92").Value
-C92 = Range("C92").Value
-If B92 = C92 Then
-Range("D92").Value = "OK"
-Else
-Range("D92").Value = "NG"
-End If
-End Function
-
-Function test_xlButtonControl(ByRef num)
-Range("A93").Clear
-Range("B93").Clear
-Range("C93").Clear
-Range("D93").Clear
-Range("A93").Value = "xlButtonControl"
-Range("B93").Value = 0
-Range("C93").Value = num
-B93 = Range("B93").Value
-C93 = Range("C93").Value
-If B93 = C93 Then
-Range("D93").Value = "OK"
-Else
-Range("D93").Value = "NG"
-End If
-End Function
-
-Function test_xlCheckBox(ByRef num)
-Range("A94").Clear
-Range("B94").Clear
-Range("C94").Clear
-Range("D94").Clear
-Range("A94").Value = "xlCheckBox"
-Range("B94").Value = 1
-Range("C94").Value = num
-B94 = Range("B94").Value
-C94 = Range("C94").Value
-If B94 = C94 Then
-Range("D94").Value = "OK"
-Else
-Range("D94").Value = "NG"
-End If
-End Function
-
-Function test_xlDropDown(ByRef num)
-Range("A95").Clear
-Range("B95").Clear
-Range("C95").Clear
-Range("D95").Clear
-Range("A95").Value = "xlDropDown"
-Range("B95").Value = 2
-Range("C95").Value = num
-B95 = Range("B95").Value
-C95 = Range("C95").Value
-If B95 = C95 Then
-Range("D95").Value = "OK"
-Else
-Range("D95").Value = "NG"
-End If
-End Function
-
-Function test_xlEditBox(ByRef num)
-Range("A96").Clear
-Range("B96").Clear
-Range("C96").Clear
-Range("D96").Clear
-Range("A96").Value = "xlEditBox"
-Range("B96").Value = 3
-Range("C96").Value = num
-B96 = Range("B96").Value
-C96 = Range("C96").Value
-If B96 = C96 Then
-Range("D96").Value = "OK"
-Else
-Range("D96").Value = "NG"
-End If
-End Function
-
-Function test_xlGroupBox(ByRef num)
-Range("A97").Clear
-Range("B97").Clear
-Range("C97").Clear
-Range("D97").Clear
-Range("A97").Value = "xlGroupBox"
-Range("B97").Value = 4
-Range("C97").Value = num
-B97 = Range("B97").Value
-C97 = Range("C97").Value
-If B97 = C97 Then
-Range("D97").Value = "OK"
-Else
-Range("D97").Value = "NG"
-End If
-End Function
-
-Function test_xlLabel(ByRef num)
-Range("A98").Clear
-Range("B98").Clear
-Range("C98").Clear
-Range("D98").Clear
-Range("A98").Value = "xlLabel"
-Range("B98").Value = 5
-Range("C98").Value = num
-B98 = Range("B98").Value
-C98 = Range("C98").Value
-If B98 = C98 Then
-Range("D98").Value = "OK"
-Else
-Range("D98").Value = "NG"
-End If
-End Function
-
-Function test_xlListBox(ByRef num)
-Range("A99").Clear
-Range("B99").Clear
-Range("C99").Clear
-Range("D99").Clear
-Range("A99").Value = "xlListBox"
-Range("B99").Value = 6
-Range("C99").Value = num
-B99 = Range("B99").Value
-C99 = Range("C99").Value
-If B99 = C99 Then
-Range("D99").Value = "OK"
-Else
-Range("D99").Value = "NG"
-End If
-End Function
-
-Function test_xlOptionButton(ByRef num)
-Range("A100").Clear
-Range("B100").Clear
-Range("C100").Clear
-Range("D100").Clear
-Range("A100").Value = "xlOptionButton"
-Range("B100").Value = 7
-Range("C100").Value = num
-B100 = Range("B100").Value
-C100 = Range("C100").Value
-If B100 = C100 Then
-Range("D100").Value = "OK"
-Else
-Range("D100").Value = "NG"
-End If
-End Function
-
-Function test_xlSchollBar(ByRef num)
-Range("A101").Clear
-Range("B101").Clear
-Range("C101").Clear
-Range("D101").Clear
-Range("A101").Value = "xlSchollBar"
-Range("B101").Value = 8
-Range("C101").Value = num
-B101 = Range("B101").Value
-C101 = Range("C101").Value
-If B101 = C101 Then
-Range("D101").Value = "OK"
-Else
-Range("D101").Value = "NG"
-End If
-End Function
-
-Function test_xlSpinner(ByRef num)
-Range("A102").Clear
-Range("B102").Clear
-Range("C102").Clear
-Range("D102").Clear
-Range("A102").Value = "xlSpinner"
-Range("B102").Value = 9
-Range("C102").Value = num
-B102 = Range("B102").Value
-C102 = Range("C102").Value
-If B102 = C102 Then
-Range("D102").Value = "OK"
-Else
-Range("D102").Value = "NG"
-End If
-End Function
-
-Function test_xlBetween(ByRef num)
-Range("A103").Clear
-Range("B103").Clear
-Range("C103").Clear
-Range("D103").Clear
-Range("A103").Value = "xlBetween"
-Range("B103").Value = 1
-Range("C103").Value = num
-B103 = Range("B103").Value
-C103 = Range("C103").Value
-If B103 = C103 Then
-Range("D103").Value = "OK"
-Else
-Range("D103").Value = "NG"
-End If
-End Function
-
-Function test_xlEqual(ByRef num)
-Range("A104").Clear
-Range("B104").Clear
-Range("C104").Clear
-Range("D104").Clear
-Range("A104").Value = "xlEqual"
-Range("B104").Value = 3
-Range("C104").Value = num
-B104 = Range("B104").Value
-C104 = Range("C104").Value
-If B104 = C104 Then
-Range("D104").Value = "OK"
-Else
-Range("D104").Value = "NG"
-End If
-End Function
-
-Function test_xlGreater(ByRef num)
-Range("A105").Clear
-Range("B105").Clear
-Range("C105").Clear
-Range("D105").Clear
-Range("A105").Value = "xlGreater"
-Range("B105").Value = 5
-Range("C105").Value = num
-B105 = Range("B105").Value
-C105 = Range("C105").Value
-If B105 = C105 Then
-Range("D105").Value = "OK"
-Else
-Range("D105").Value = "NG"
-End If
-End Function
-
-Function test_xlGreaterEqual(ByRef num)
-Range("A106").Clear
-Range("B106").Clear
-Range("C106").Clear
-Range("D106").Clear
-Range("A106").Value = "xlGreaterEqual"
-Range("B106").Value = 7
-Range("C106").Value = num
-B106 = Range("B106").Value
-C106 = Range("C106").Value
-If B106 = C106 Then
-Range("D106").Value = "OK"
-Else
-Range("D106").Value = "NG"
-End If
-End Function
-
-Function test_xlLess(ByRef num)
-Range("A107").Clear
-Range("B107").Clear
-Range("C107").Clear
-Range("D107").Clear
-Range("A107").Value = "xlLess"
-Range("B107").Value = 6
-Range("C107").Value = num
-B107 = Range("B107").Value
-C107 = Range("C107").Value
-If B107 = C107 Then
-Range("D107").Value = "OK"
-Else
-Range("D107").Value = "NG"
-End If
-End Function
-
-Function test_xlLessEqual(ByRef num)
-Range("A108").Clear
-Range("B108").Clear
-Range("C108").Clear
-Range("D108").Clear
-Range("A108").Value = "xlLessEqual"
-Range("B108").Value = 8
-Range("C108").Value = num
-B108 = Range("B108").Value
-C108 = Range("C108").Value
-If B108 = C108 Then
-Range("D108").Value = "OK"
-Else
-Range("D108").Value = "NG"
-End If
-End Function
-
-Function test_xlNotBetween(ByRef num)
-Range("A109").Clear
-Range("B109").Clear
-Range("C109").Clear
-Range("D109").Clear
-Range("A109").Value = "xlNotBetween"
-Range("B109").Value = 2
-Range("C109").Value = num
-B109 = Range("B109").Value
-C109 = Range("C109").Value
-If B109 = C109 Then
-Range("D109").Value = "OK"
-Else
-Range("D109").Value = "NG"
-End If
-End Function
-
-Function test_xlNotEqual(ByRef num)
-Range("A110").Clear
-Range("B110").Clear
-Range("C110").Clear
-Range("D110").Clear
-Range("A110").Value = "xlNotEqual"
-Range("B110").Value = 4
-Range("C110").Value = num
-B110 = Range("B110").Value
-C110 = Range("C110").Value
-If B110 = C110 Then
-Range("D110").Value = "OK"
-Else
-Range("D110").Value = "NG"
-End If
-End Function
-
-Function test_xlCellValue(ByRef num)
-Range("A111").Clear
-Range("B111").Clear
-Range("C111").Clear
-Range("D111").Clear
-Range("A111").Value = "xlCellValue"
-Range("B111").Value = 1
-Range("C111").Value = num
-B111 = Range("B111").Value
-C111 = Range("C111").Value
-If B111 = C111 Then
-Range("D111").Value = "OK"
-Else
-Range("D111").Value = "NG"
-End If
-End Function
-
-Function test_xlExpression(ByRef num)
-Range("A112").Clear
-Range("B112").Clear
-Range("C112").Clear
-Range("D112").Clear
-Range("A112").Value = "xlExpression"
-Range("B112").Value = 2
-Range("C112").Value = num
-B112 = Range("B112").Value
-C112 = Range("C112").Value
-If B112 = C112 Then
-Range("D112").Value = "OK"
-Else
-Range("D112").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnLabels(ByRef num)
-Range("A113").Clear
-Range("B113").Clear
-Range("C113").Clear
-Range("D113").Clear
-Range("A113").Value = "xlColumnLabels"
-Range("B113").Value = 2
-Range("C113").Value = num
-B113 = Range("B113").Value
-C113 = Range("C113").Value
-If B113 = C113 Then
-Range("D113").Value = "OK"
-Else
-Range("D113").Value = "NG"
-End If
-End Function
-
-Function test_xlMixedLabels(ByRef num)
-Range("A114").Clear
-Range("B114").Clear
-Range("C114").Clear
-Range("D114").Clear
-Range("A114").Value = "xlMixedLabels"
-Range("B114").Value = 3
-Range("C114").Value = num
-B114 = Range("B114").Value
-C114 = Range("C114").Value
-If B114 = C114 Then
-Range("D114").Value = "OK"
-Else
-Range("D114").Value = "NG"
-End If
-End Function
-
-Function test_xlNoLabels(ByRef num)
-Range("A115").Clear
-Range("B115").Clear
-Range("C115").Clear
-Range("D115").Clear
-Range("A115").Value = "xlNoLabels"
-Range("B115").Value = -4142
-Range("C115").Value = num
-B115 = Range("B115").Value
-C115 = Range("C115").Value
-If B115 = C115 Then
-Range("D115").Value = "OK"
-Else
-Range("D115").Value = "NG"
-End If
-End Function
-
-Function test_xlRowLabels(ByRef num)
-Range("A116").Clear
-Range("B116").Clear
-Range("C116").Clear
-Range("D116").Clear
-Range("A116").Value = "xlRowLabels"
-Range("B116").Value = 1
-Range("C116").Value = num
-B116 = Range("B116").Value
-C116 = Range("C116").Value
-If B116 = C116 Then
-Range("D116").Value = "OK"
-Else
-Range("D116").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignCenter(ByRef num)
-Range("A117").Clear
-Range("B117").Clear
-Range("C117").Clear
-Range("D117").Clear
-Range("A117").Value = "xlHAlignCenter"
-Range("B117").Value = -4108
-Range("C117").Value = num
-B117 = Range("B117").Value
-C117 = Range("C117").Value
-If B117 = C117 Then
-Range("D117").Value = "OK"
-Else
-Range("D117").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignCenterAcrossSelection(ByRef num)
-Range("A118").Clear
-Range("B118").Clear
-Range("C118").Clear
-Range("D118").Clear
-Range("A118").Value = "xlHAlignCenterAcrossSelection"
-Range("B118").Value = 7
-Range("C118").Value = num
-B118 = Range("B118").Value
-C118 = Range("C118").Value
-If B118 = C118 Then
-Range("D118").Value = "OK"
-Else
-Range("D118").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignDistributed(ByRef num)
-Range("A119").Clear
-Range("B119").Clear
-Range("C119").Clear
-Range("D119").Clear
-Range("A119").Value = "xlHAlignDistributed"
-Range("B119").Value = -4117
-Range("C119").Value = num
-B119 = Range("B119").Value
-C119 = Range("C119").Value
-If B119 = C119 Then
-Range("D119").Value = "OK"
-Else
-Range("D119").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignFull(ByRef num)
-Range("A120").Clear
-Range("B120").Clear
-Range("C120").Clear
-Range("D120").Clear
-Range("A120").Value = "xlHAlignFull"
-Range("B120").Value = 5
-Range("C120").Value = num
-B120 = Range("B120").Value
-C120 = Range("C120").Value
-If B120 = C120 Then
-Range("D120").Value = "OK"
-Else
-Range("D120").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignGeneral(ByRef num)
-Range("A121").Clear
-Range("B121").Clear
-Range("C121").Clear
-Range("D121").Clear
-Range("A121").Value = "xlHAlignGeneral"
-Range("B121").Value = 1
-Range("C121").Value = num
-B121 = Range("B121").Value
-C121 = Range("C121").Value
-If B121 = C121 Then
-Range("D121").Value = "OK"
-Else
-Range("D121").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignJustify(ByRef num)
-Range("A122").Clear
-Range("B122").Clear
-Range("C122").Clear
-Range("D122").Clear
-Range("A122").Value = "xlHAlignJustify"
-Range("B122").Value = -4130
-Range("C122").Value = num
-B122 = Range("B122").Value
-C122 = Range("C122").Value
-If B122 = C122 Then
-Range("D122").Value = "OK"
-Else
-Range("D122").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignLeft(ByRef num)
-Range("A123").Clear
-Range("B123").Clear
-Range("C123").Clear
-Range("D123").Clear
-Range("A123").Value = "xlHAlignLeft"
-Range("B123").Value = -4131
-Range("C123").Value = num
-B123 = Range("B123").Value
-C123 = Range("C123").Value
-If B123 = C123 Then
-Range("D123").Value = "OK"
-Else
-Range("D123").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignRight(ByRef num)
-Range("A124").Clear
-Range("B124").Clear
-Range("C124").Clear
-Range("D124").Clear
-Range("A124").Value = "xlHAlignRight"
-Range("B124").Value = -4152
-Range("C124").Value = num
-B124 = Range("B124").Value
-C124 = Range("C124").Value
-If B124 = C124 Then
-Range("D124").Value = "OK"
-Else
-Range("D124").Value = "NG"
-End If
-End Function
-
-Function test_xlHebrewFullScript(ByRef num)
-Range("A125").Clear
-Range("B125").Clear
-Range("C125").Clear
-Range("D125").Clear
-Range("A125").Value = "xlHebrewFullScript"
-Range("B125").Value = 0
-Range("C125").Value = num
-B125 = Range("B125").Value
-C125 = Range("C125").Value
-If B125 = C125 Then
-Range("D125").Value = "OK"
-Else
-Range("D125").Value = "NG"
-End If
-End Function
-
-Function test_xlHebrewMixedAuthorizedScript(ByRef num)
-Range("A126").Clear
-Range("B126").Clear
-Range("C126").Clear
-Range("D126").Clear
-Range("A126").Value = "xlHebrewMixedAuthorizedScript"
-Range("B126").Value = 3
-Range("C126").Value = num
-B126 = Range("B126").Value
-C126 = Range("C126").Value
-If B126 = C126 Then
-Range("D126").Value = "OK"
-Else
-Range("D126").Value = "NG"
-End If
-End Function
-
-Function test_xlHebrewMixedScript(ByRef num)
-Range("A127").Clear
-Range("B127").Clear
-Range("C127").Clear
-Range("D127").Clear
-Range("A127").Value = "xlHebrewMixedScript"
-Range("B127").Value = 2
-Range("C127").Value = num
-B127 = Range("B127").Value
-C127 = Range("C127").Value
-If B127 = C127 Then
-Range("D127").Value = "OK"
-Else
-Range("D127").Value = "NG"
-End If
-End Function
-
-Function test_xlHebrewPartialScript(ByRef num)
-Range("A128").Clear
-Range("B128").Clear
-Range("C128").Clear
-Range("D128").Clear
-Range("A128").Value = "xlHebrewPartialScript"
-Range("B128").Value = 1
-Range("C128").Value = num
-B128 = Range("B128").Value
-C128 = Range("C128").Value
-If B128 = C128 Then
-Range("D128").Value = "OK"
-Else
-Range("D128").Value = "NG"
-End If
-End Function
-
-Function test_xlAllChanges(ByRef num)
-Range("A129").Clear
-Range("B129").Clear
-Range("C129").Clear
-Range("D129").Clear
-Range("A129").Value = "xlAllChanges"
-Range("B129").Value = 2
-Range("C129").Value = num
-B129 = Range("B129").Value
-C129 = Range("C129").Value
-If B129 = C129 Then
-Range("D129").Value = "OK"
-Else
-Range("D129").Value = "NG"
-End If
-End Function
-
-Function test_xlNotYetReviewed(ByRef num)
-Range("A130").Clear
-Range("B130").Clear
-Range("C130").Clear
-Range("D130").Clear
-Range("A130").Value = "xlNotYetReviewed"
-Range("B130").Value = 3
-Range("C130").Value = num
-B130 = Range("B130").Value
-C130 = Range("C130").Value
-If B130 = C130 Then
-Range("D130").Value = "OK"
-Else
-Range("D130").Value = "NG"
-End If
-End Function
-
-Function test_xlSinceMyLastSave(ByRef num)
-Range("A131").Clear
-Range("B131").Clear
-Range("C131").Clear
-Range("D131").Clear
-Range("A131").Value = "xlSinceMyLastSave"
-Range("B131").Value = 1
-Range("C131").Value = num
-B131 = Range("B131").Value
-C131 = Range("C131").Value
-If B131 = C131 Then
-Range("D131").Value = "OK"
-Else
-Range("D131").Value = "NG"
-End If
-End Function
-
-Function test_xlHtmlCalc(ByRef num)
-Range("A132").Clear
-Range("B132").Clear
-Range("C132").Clear
-Range("D132").Clear
-Range("A132").Value = "xlHtmlCalc"
-Range("B132").Value = 1
-Range("C132").Value = num
-B132 = Range("B132").Value
-C132 = Range("C132").Value
-If B132 = C132 Then
-Range("D132").Value = "OK"
-Else
-Range("D132").Value = "NG"
-End If
-End Function
-
-Function test_xlHtmlChart(ByRef num)
-Range("A133").Clear
-Range("B133").Clear
-Range("C133").Clear
-Range("D133").Clear
-Range("A133").Value = "xlHtmlChart"
-Range("B133").Value = 3
-Range("C133").Value = num
-B133 = Range("B133").Value
-C133 = Range("C133").Value
-If B133 = C133 Then
-Range("D133").Value = "OK"
-Else
-Range("D133").Value = "NG"
-End If
-End Function
-
-Function test_xlHtmlList(ByRef num)
-Range("A134").Clear
-Range("B134").Clear
-Range("C134").Clear
-Range("D134").Clear
-Range("A134").Value = "xlHtmlList"
-Range("B134").Value = 2
-Range("C134").Value = num
-B134 = Range("B134").Value
-C134 = Range("C134").Value
-If B134 = C134 Then
-Range("D134").Value = "OK"
-Else
-Range("D134").Value = "NG"
-End If
-End Function
-
-Function test_xlHtmlStatic(ByRef num)
-Range("A135").Clear
-Range("B135").Clear
-Range("C135").Clear
-Range("D135").Clear
-Range("A135").Value = "xlHtmlStatic"
-Range("B135").Value = 0
-Range("C135").Value = num
-B135 = Range("B135").Value
-C135 = Range("C135").Value
-If B135 = C135 Then
-Range("D135").Value = "OK"
-Else
-Range("D135").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeAlpha(ByRef num)
-Range("A136").Clear
-Range("B136").Clear
-Range("C136").Clear
-Range("D136").Clear
-Range("A136").Value = "xlIMEModeAlpha"
-Range("B136").Value = 8
-Range("C136").Value = num
-B136 = Range("B136").Value
-C136 = Range("C136").Value
-If B136 = C136 Then
-Range("D136").Value = "OK"
-Else
-Range("D136").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeAlphaFull(ByRef num)
-Range("A137").Clear
-Range("B137").Clear
-Range("C137").Clear
-Range("D137").Clear
-Range("A137").Value = "xlIMEModeAlphaFull"
-Range("B137").Value = 7
-Range("C137").Value = num
-B137 = Range("B137").Value
-C137 = Range("C137").Value
-If B137 = C137 Then
-Range("D137").Value = "OK"
-Else
-Range("D137").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeDisable(ByRef num)
-Range("A138").Clear
-Range("B138").Clear
-Range("C138").Clear
-Range("D138").Clear
-Range("A138").Value = "xlIMEModeDisable"
-Range("B138").Value = 3
-Range("C138").Value = num
-B138 = Range("B138").Value
-C138 = Range("C138").Value
-If B138 = C138 Then
-Range("D138").Value = "OK"
-Else
-Range("D138").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeHangul(ByRef num)
-Range("A139").Clear
-Range("B139").Clear
-Range("C139").Clear
-Range("D139").Clear
-Range("A139").Value = "xlIMEModeHangul"
-Range("B139").Value = 10
-Range("C139").Value = num
-B139 = Range("B139").Value
-C139 = Range("C139").Value
-If B139 = C139 Then
-Range("D139").Value = "OK"
-Else
-Range("D139").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeHangulFull(ByRef num)
-Range("A140").Clear
-Range("B140").Clear
-Range("C140").Clear
-Range("D140").Clear
-Range("A140").Value = "xlIMEModeHangulFull"
-Range("B140").Value = 9
-Range("C140").Value = num
-B140 = Range("B140").Value
-C140 = Range("C140").Value
-If B140 = C140 Then
-Range("D140").Value = "OK"
-Else
-Range("D140").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeHiragana(ByRef num)
-Range("A141").Clear
-Range("B141").Clear
-Range("C141").Clear
-Range("D141").Clear
-Range("A141").Value = "xlIMEModeHiragana"
-Range("B141").Value = 4
-Range("C141").Value = num
-B141 = Range("B141").Value
-C141 = Range("C141").Value
-If B141 = C141 Then
-Range("D141").Value = "OK"
-Else
-Range("D141").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeKatakana(ByRef num)
-Range("A142").Clear
-Range("B142").Clear
-Range("C142").Clear
-Range("D142").Clear
-Range("A142").Value = "xlIMEModeKatakana"
-Range("B142").Value = 5
-Range("C142").Value = num
-B142 = Range("B142").Value
-C142 = Range("C142").Value
-If B142 = C142 Then
-Range("D142").Value = "OK"
-Else
-Range("D142").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeKatakanaHalf(ByRef num)
-Range("A143").Clear
-Range("B143").Clear
-Range("C143").Clear
-Range("D143").Clear
-Range("A143").Value = "xlIMEModeKatakanaHalf"
-Range("B143").Value = 6
-Range("C143").Value = num
-B143 = Range("B143").Value
-C143 = Range("C143").Value
-If B143 = C143 Then
-Range("D143").Value = "OK"
-Else
-Range("D143").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeNoControl(ByRef num)
-Range("A144").Clear
-Range("B144").Clear
-Range("C144").Clear
-Range("D144").Clear
-Range("A144").Value = "xlIMEModeNoControl"
-Range("B144").Value = 0
-Range("C144").Value = num
-B144 = Range("B144").Value
-C144 = Range("C144").Value
-If B144 = C144 Then
-Range("D144").Value = "OK"
-Else
-Range("D144").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeOff(ByRef num)
-Range("A145").Clear
-Range("B145").Clear
-Range("C145").Clear
-Range("D145").Clear
-Range("A145").Value = "xlIMEModeOff"
-Range("B145").Value = 2
-Range("C145").Value = num
-B145 = Range("B145").Value
-C145 = Range("C145").Value
-If B145 = C145 Then
-Range("D145").Value = "OK"
-Else
-Range("D145").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeOn(ByRef num)
-Range("A146").Clear
-Range("B146").Clear
-Range("C146").Clear
-Range("D146").Clear
-Range("A146").Value = "xlIMEModeOn"
-Range("B146").Value = 1
-Range("C146").Value = num
-B146 = Range("B146").Value
-C146 = Range("C146").Value
-If B146 = C146 Then
-Range("D146").Value = "OK"
-Else
-Range("D146").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotTableReport(ByRef num)
-Range("A147").Clear
-Range("B147").Clear
-Range("C147").Clear
-Range("D147").Clear
-Range("A147").Value = "xlPivotTableReport"
-Range("B147").Value = 1
-Range("C147").Value = num
-B147 = Range("B147").Value
-C147 = Range("C147").Value
-If B147 = C147 Then
-Range("D147").Value = "OK"
-Else
-Range("D147").Value = "NG"
-End If
-End Function
-
-Function test_xlQueryTable(ByRef num)
-Range("A148").Clear
-Range("B148").Clear
-Range("C148").Clear
-Range("D148").Clear
-Range("A148").Value = "xlQueryTable"
-Range("B148").Value = 0
-Range("C148").Value = num
-B148 = Range("B148").Value
-C148 = Range("C148").Value
-If B148 = C148 Then
-Range("D148").Value = "OK"
-Else
-Range("D148").Value = "NG"
-End If
-End Function
-
-Function test_xlFormatFromLeftOrAbove(ByRef num)
-Range("A149").Clear
-Range("B149").Clear
-Range("C149").Clear
-Range("D149").Clear
-Range("A149").Value = "xlFormatFromLeftOrAbove"
-Range("B149").Value = 0
-Range("C149").Value = num
-B149 = Range("B149").Value
-C149 = Range("C149").Value
-If B149 = C149 Then
-Range("D149").Value = "OK"
-Else
-Range("D149").Value = "NG"
-End If
-End Function
-
-Function test_xlFormatFromRightOrAbove(ByRef num)
-Range("A150").Clear
-Range("B150").Clear
-Range("C150").Clear
-Range("D150").Clear
-Range("A150").Value = "xlFormatFromRightOrAbove"
-Range("B150").Value = 1
-Range("C150").Value = num
-B150 = Range("B150").Value
-C150 = Range("C150").Value
-If B150 = C150 Then
-Range("D150").Value = "OK"
-Else
-Range("D150").Value = "NG"
-End If
-End Function
-
-Function test_xlShiftDown(ByRef num)
-Range("A151").Clear
-Range("B151").Clear
-Range("C151").Clear
-Range("D151").Clear
-Range("A151").Value = "xlShiftDown"
-Range("B151").Value = -4121
-Range("C151").Value = num
-B151 = Range("B151").Value
-C151 = Range("C151").Value
-If B151 = C151 Then
-Range("D151").Value = "OK"
-Else
-Range("D151").Value = "NG"
-End If
-End Function
-
-Function test_xlShiftToRight(ByRef num)
-Range("A152").Clear
-Range("B152").Clear
-Range("C152").Clear
-Range("D152").Clear
-Range("A152").Value = "xlShiftToRight"
-Range("B152").Value = -4161
-Range("C152").Value = num
-B152 = Range("B152").Value
-C152 = Range("C152").Value
-If B152 = C152 Then
-Range("D152").Value = "OK"
-Else
-Range("D152").Value = "NG"
-End If
-End Function
-
-Function test_xlOutline(ByRef num)
-Range("A153").Clear
-Range("B153").Clear
-Range("C153").Clear
-Range("D153").Clear
-Range("A153").Value = "xlOutline"
-Range("B153").Value = 1
-Range("C153").Value = num
-B153 = Range("B153").Value
-C153 = Range("C153").Value
-If B153 = C153 Then
-Range("D153").Value = "OK"
-Else
-Range("D153").Value = "NG"
-End If
-End Function
-
-Function test_xlTabular(ByRef num)
-Range("A154").Clear
-Range("B154").Clear
-Range("C154").Clear
-Range("D154").Clear
-Range("A154").Value = "xlTabular"
-Range("B154").Value = 0
-Range("C154").Value = num
-B154 = Range("B154").Value
-C154 = Range("C154").Value
-If B154 = C154 Then
-Range("D154").Value = "OK"
-Else
-Range("D154").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendPositionBottom(ByRef num)
-Range("A155").Clear
-Range("B155").Clear
-Range("C155").Clear
-Range("D155").Clear
-Range("A155").Value = "xlLegendPositionBottom"
-Range("B155").Value = -4107
-Range("C155").Value = num
-B155 = Range("B155").Value
-C155 = Range("C155").Value
-If B155 = C155 Then
-Range("D155").Value = "OK"
-Else
-Range("D155").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendPositionCorner(ByRef num)
-Range("A156").Clear
-Range("B156").Clear
-Range("C156").Clear
-Range("D156").Clear
-Range("A156").Value = "xlLegendPositionCorner"
-Range("B156").Value = 2
-Range("C156").Value = num
-B156 = Range("B156").Value
-C156 = Range("C156").Value
-If B156 = C156 Then
-Range("D156").Value = "OK"
-Else
-Range("D156").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendPositionLeft(ByRef num)
-Range("A157").Clear
-Range("B157").Clear
-Range("C157").Clear
-Range("D157").Clear
-Range("A157").Value = "xlLegendPositionLeft"
-Range("B157").Value = -4131
-Range("C157").Value = num
-B157 = Range("B157").Value
-C157 = Range("C157").Value
-If B157 = C157 Then
-Range("D157").Value = "OK"
-Else
-Range("D157").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendPositionRight(ByRef num)
-Range("A158").Clear
-Range("B158").Clear
-Range("C158").Clear
-Range("D158").Clear
-Range("A158").Value = "xlLegendPositionRight"
-Range("B158").Value = -4152
-Range("C158").Value = num
-B158 = Range("B158").Value
-C158 = Range("C158").Value
-If B158 = C158 Then
-Range("D158").Value = "OK"
-Else
-Range("D158").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendPositionTop(ByRef num)
-Range("A159").Clear
-Range("B159").Clear
-Range("C159").Clear
-Range("D159").Clear
-Range("A159").Value = "xlLegendPositionTop"
-Range("B159").Value = -4160
-Range("C159").Value = num
-B159 = Range("B159").Value
-C159 = Range("C159").Value
-If B159 = C159 Then
-Range("D159").Value = "OK"
-Else
-Range("D159").Value = "NG"
-End If
-End Function
-
-Function test_xlContinuous(ByRef num)
-Range("A160").Clear
-Range("B160").Clear
-Range("C160").Clear
-Range("D160").Clear
-Range("A160").Value = "xlContinuous"
-Range("B160").Value = 1
-Range("C160").Value = num
-B160 = Range("B160").Value
-C160 = Range("C160").Value
-If B160 = C160 Then
-Range("D160").Value = "OK"
-Else
-Range("D160").Value = "NG"
-End If
-End Function
-
-Function test_xlDash(ByRef num)
-Range("A161").Clear
-Range("B161").Clear
-Range("C161").Clear
-Range("D161").Clear
-Range("A161").Value = "xlDash"
-Range("B161").Value = -4115
-Range("C161").Value = num
-B161 = Range("B161").Value
-C161 = Range("C161").Value
-If B161 = C161 Then
-Range("D161").Value = "OK"
-Else
-Range("D161").Value = "NG"
-End If
-End Function
-
-Function test_xlDashDot(ByRef num)
-Range("A162").Clear
-Range("B162").Clear
-Range("C162").Clear
-Range("D162").Clear
-Range("A162").Value = "xlDashDot"
-Range("B162").Value = 4
-Range("C162").Value = num
-B162 = Range("B162").Value
-C162 = Range("C162").Value
-If B162 = C162 Then
-Range("D162").Value = "OK"
-Else
-Range("D162").Value = "NG"
-End If
-End Function
-
-Function test_xlDashDotDot(ByRef num)
-Range("A163").Clear
-Range("B163").Clear
-Range("C163").Clear
-Range("D163").Clear
-Range("A163").Value = "xlDashDotDot"
-Range("B163").Value = 5
-Range("C163").Value = num
-B163 = Range("B163").Value
-C163 = Range("C163").Value
-If B163 = C163 Then
-Range("D163").Value = "OK"
-Else
-Range("D163").Value = "NG"
-End If
-End Function
-
-Function test_xlDot(ByRef num)
-Range("A164").Clear
-Range("B164").Clear
-Range("C164").Clear
-Range("D164").Clear
-Range("A164").Value = "xlDot"
-Range("B164").Value = -4118
-Range("C164").Value = num
-B164 = Range("B164").Value
-C164 = Range("C164").Value
-If B164 = C164 Then
-Range("D164").Value = "OK"
-Else
-Range("D164").Value = "NG"
-End If
-End Function
-
-Function test_xlDouble(ByRef num)
-Range("A165").Clear
-Range("B165").Clear
-Range("C165").Clear
-Range("D165").Clear
-Range("A165").Value = "xlDouble"
-Range("B165").Value = -4119
-Range("C165").Value = num
-B165 = Range("B165").Value
-C165 = Range("C165").Value
-If B165 = C165 Then
-Range("D165").Value = "OK"
-Else
-Range("D165").Value = "NG"
-End If
-End Function
-
-Function test_xlLineStyleNone(ByRef num)
-Range("A166").Clear
-Range("B166").Clear
-Range("C166").Clear
-Range("D166").Clear
-Range("A166").Value = "xlLineStyleNone"
-Range("B166").Value = -4142
-Range("C166").Value = num
-B166 = Range("B166").Value
-C166 = Range("C166").Value
-If B166 = C166 Then
-Range("D166").Value = "OK"
-Else
-Range("D166").Value = "NG"
-End If
-End Function
-
-Function test_xlSlantDashDot(ByRef num)
-Range("A167").Clear
-Range("B167").Clear
-Range("C167").Clear
-Range("D167").Clear
-Range("A167").Value = "xlSlantDashDot"
-Range("B167").Value = 13
-Range("C167").Value = num
-B167 = Range("B167").Value
-C167 = Range("C167").Value
-If B167 = C167 Then
-Range("D167").Value = "OK"
-Else
-Range("D167").Value = "NG"
-End If
-End Function
-
-Function test_xlExcelLink(ByRef num)
-Range("A168").Clear
-Range("B168").Clear
-Range("C168").Clear
-Range("D168").Clear
-Range("A168").Value = "xlExcelLink"
-Range("B168").Value = 1
-Range("C168").Value = num
-B168 = Range("B168").Value
-C168 = Range("C168").Value
-If B168 = C168 Then
-Range("D168").Value = "OK"
-Else
-Range("D168").Value = "NG"
-End If
-End Function
-
-Function test_XlOLELink(ByRef num)
-Range("A169").Clear
-Range("B169").Clear
-Range("C169").Clear
-Range("D169").Clear
-Range("A169").Value = "xlOLELink"
-Range("B169").Value = 2
-Range("C169").Value = num
-B169 = Range("B169").Value
-C169 = Range("C169").Value
-If B169 = C169 Then
-Range("D169").Value = "OK"
-Else
-Range("D169").Value = "NG"
-End If
-End Function
-
-Function test_xlPublishers(ByRef num)
-Range("A170").Clear
-Range("B170").Clear
-Range("C170").Clear
-Range("D170").Clear
-Range("A170").Value = "xlPublishers"
-Range("B170").Value = 5
-Range("C170").Value = num
-B170 = Range("B170").Value
-C170 = Range("C170").Value
-If B170 = C170 Then
-Range("D170").Value = "OK"
-Else
-Range("D170").Value = "NG"
-End If
-End Function
-
-Function test_xlSubscribers(ByRef num)
-Range("A171").Clear
-Range("B171").Clear
-Range("C171").Clear
-Range("D171").Clear
-Range("A171").Value = "xlSubscribers"
-Range("B171").Value = 6
-Range("C171").Value = num
-B171 = Range("B171").Value
-C171 = Range("C171").Value
-If B171 = C171 Then
-Range("D171").Value = "OK"
-Else
-Range("D171").Value = "NG"
-End If
-End Function
-
-Function test_xlEditionDate(ByRef num)
-Range("A172").Clear
-Range("B172").Clear
-Range("C172").Clear
-Range("D172").Clear
-Range("A172").Value = "xlEditionDate"
-Range("B172").Value = 2
-Range("C172").Value = num
-B172 = Range("B172").Value
-C172 = Range("C172").Value
-If B172 = C172 Then
-Range("D172").Value = "OK"
-Else
-Range("D172").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkInfoStatus(ByRef num)
-Range("A173").Clear
-Range("B173").Clear
-Range("C173").Clear
-Range("D173").Clear
-Range("A173").Value = "xlLinkInfoStatus"
-Range("B173").Value = 3
-Range("C173").Value = num
-B173 = Range("B173").Value
-C173 = Range("C173").Value
-If B173 = C173 Then
-Range("D173").Value = "OK"
-Else
-Range("D173").Value = "NG"
-End If
-End Function
-
-Function test_xlUpdateState(ByRef num)
-Range("A174").Clear
-Range("B174").Clear
-Range("C174").Clear
-Range("D174").Clear
-Range("A174").Value = "xlUpdateState"
-Range("B174").Value = 1
-Range("C174").Value = num
-B174 = Range("B174").Value
-C174 = Range("C174").Value
-If B174 = C174 Then
-Range("D174").Value = "OK"
-Else
-Range("D174").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkInfoOLELinks(ByRef num)
-Range("A175").Clear
-Range("B175").Clear
-Range("C175").Clear
-Range("D175").Clear
-Range("A175").Value = "xlLinkInfoOLELinks"
-Range("B175").Value = 2
-Range("C175").Value = num
-B175 = Range("B175").Value
-C175 = Range("C175").Value
-If B175 = C175 Then
-Range("D175").Value = "OK"
-Else
-Range("D175").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkInfoPublishers(ByRef num)
-Range("A176").Clear
-Range("B176").Clear
-Range("C176").Clear
-Range("D176").Clear
-Range("A176").Value = "xlLinkInfoPublishers"
-Range("B176").Value = 5
-Range("C176").Value = num
-B176 = Range("B176").Value
-C176 = Range("C176").Value
-If B176 = C176 Then
-Range("D176").Value = "OK"
-Else
-Range("D176").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkInfoSubscribers(ByRef num)
-Range("A177").Clear
-Range("B177").Clear
-Range("C177").Clear
-Range("D177").Clear
-Range("A177").Value = "xlLinkInfoSubscribers"
-Range("B177").Value = 6
-Range("C177").Value = num
-B177 = Range("B177").Value
-C177 = Range("C177").Value
-If B177 = C177 Then
-Range("D177").Value = "OK"
-Else
-Range("D177").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusCopiedValues(ByRef num)
-Range("A178").Clear
-Range("B178").Clear
-Range("C178").Clear
-Range("D178").Clear
-Range("A178").Value = "xlLinkStatusCopiedValues"
-Range("B178").Value = 10
-Range("C178").Value = num
-B178 = Range("B178").Value
-C178 = Range("C178").Value
-If B178 = C178 Then
-Range("D178").Value = "OK"
-Else
-Range("D178").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusIndeterminate(ByRef num)
-Range("A179").Clear
-Range("B179").Clear
-Range("C179").Clear
-Range("D179").Clear
-Range("A179").Value = "xlLinkStatusIndeterminate"
-Range("B179").Value = 5
-Range("C179").Value = num
-B179 = Range("B179").Value
-C179 = Range("C179").Value
-If B179 = C179 Then
-Range("D179").Value = "OK"
-Else
-Range("D179").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusInvalidName(ByRef num)
-Range("A180").Clear
-Range("B180").Clear
-Range("C180").Clear
-Range("D180").Clear
-Range("A180").Value = "xlLinkStatusInvalidName"
-Range("B180").Value = 7
-Range("C180").Value = num
-B180 = Range("B180").Value
-C180 = Range("C180").Value
-If B180 = C180 Then
-Range("D180").Value = "OK"
-Else
-Range("D180").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusMissingFile(ByRef num)
-Range("A181").Clear
-Range("B181").Clear
-Range("C181").Clear
-Range("D181").Clear
-Range("A181").Value = "xlLinkStatusMissingFile"
-Range("B181").Value = 1
-Range("C181").Value = num
-B181 = Range("B181").Value
-C181 = Range("C181").Value
-If B181 = C181 Then
-Range("D181").Value = "OK"
-Else
-Range("D181").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusMissingSheet(ByRef num)
-Range("A182").Clear
-Range("B182").Clear
-Range("C182").Clear
-Range("D182").Clear
-Range("A182").Value = "xlLinkStatusMissingSheet"
-Range("B182").Value = 2
-Range("C182").Value = num
-B182 = Range("B182").Value
-C182 = Range("C182").Value
-If B182 = C182 Then
-Range("D182").Value = "OK"
-Else
-Range("D182").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusNotStarted(ByRef num)
-Range("A183").Clear
-Range("B183").Clear
-Range("C183").Clear
-Range("D183").Clear
-Range("A183").Value = "xlLinkStatusNotStarted"
-Range("B183").Value = 6
-Range("C183").Value = num
-B183 = Range("B183").Value
-C183 = Range("C183").Value
-If B183 = C183 Then
-Range("D183").Value = "OK"
-Else
-Range("D183").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusOK(ByRef num)
-Range("A184").Clear
-Range("B184").Clear
-Range("C184").Clear
-Range("D184").Clear
-Range("A184").Value = "xlLinkStatusOK"
-Range("B184").Value = 0
-Range("C184").Value = num
-B184 = Range("B184").Value
-C184 = Range("C184").Value
-If B184 = C184 Then
-Range("D184").Value = "OK"
-Else
-Range("D184").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusOld(ByRef num)
-Range("A185").Clear
-Range("B185").Clear
-Range("C185").Clear
-Range("D185").Clear
-Range("A185").Value = "xlLinkStatusOld"
-Range("B185").Value = 3
-Range("C185").Value = num
-B185 = Range("B185").Value
-C185 = Range("C185").Value
-If B185 = C185 Then
-Range("D185").Value = "OK"
-Else
-Range("D185").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusSourceNotCalculated(ByRef num)
-Range("A186").Clear
-Range("B186").Clear
-Range("C186").Clear
-Range("D186").Clear
-Range("A186").Value = "xlLinkStatusSourceNotCalculated"
-Range("B186").Value = 4
-Range("C186").Value = num
-B186 = Range("B186").Value
-C186 = Range("C186").Value
-If B186 = C186 Then
-Range("D186").Value = "OK"
-Else
-Range("D186").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusSourceNotOpen(ByRef num)
-Range("A187").Clear
-Range("B187").Clear
-Range("C187").Clear
-Range("D187").Clear
-Range("A187").Value = "xlLinkStatusSourceNotOpen"
-Range("B187").Value = 8
-Range("C187").Value = num
-B187 = Range("B187").Value
-C187 = Range("C187").Value
-If B187 = C187 Then
-Range("D187").Value = "OK"
-Else
-Range("D187").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusSourceOpen(ByRef num)
-Range("A188").Clear
-Range("B188").Clear
-Range("C188").Clear
-Range("D188").Clear
-Range("A188").Value = "xlLinkStatusSourceOpen"
-Range("B188").Value = 9
-Range("C188").Value = num
-B188 = Range("B188").Value
-C188 = Range("C188").Value
-If B188 = C188 Then
-Range("D188").Value = "OK"
-Else
-Range("D188").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkTypeExcelLinks(ByRef num)
-Range("A189").Clear
-Range("B189").Clear
-Range("C189").Clear
-Range("D189").Clear
-Range("A189").Value = "xlLinkTypeExcelLinks"
-Range("B189").Value = 1
-Range("C189").Value = num
-B189 = Range("B189").Value
-C189 = Range("C189").Value
-If B189 = C189 Then
-Range("D189").Value = "OK"
-Else
-Range("D189").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkTypeOLELinks(ByRef num)
-Range("A190").Clear
-Range("B190").Clear
-Range("C190").Clear
-Range("D190").Clear
-Range("A190").Value = "xlLinkTypeOLELinks"
-Range("B190").Value = 2
-Range("C190").Value = num
-B190 = Range("B190").Value
-C190 = Range("C190").Value
-If B190 = C190 Then
-Range("D190").Value = "OK"
-Else
-Range("D190").Value = "NG"
-End If
-End Function
-
-Function test_xlListConflictDialog(ByRef num)
-Range("A191").Clear
-Range("B191").Clear
-Range("C191").Clear
-Range("D191").Clear
-Range("A191").Value = "xlListConflictDialog"
-Range("B191").Value = 0
-Range("C191").Value = num
-B191 = Range("B191").Value
-C191 = Range("C191").Value
-If B191 = C191 Then
-Range("D191").Value = "OK"
-Else
-Range("D191").Value = "NG"
-End If
-End Function
-
-Function test_xlListConflictDiscardAllConflicts(ByRef num)
-Range("A192").Clear
-Range("B192").Clear
-Range("C192").Clear
-Range("D192").Clear
-Range("A192").Value = "xlListConflictDiscardAllConflicts"
-Range("B192").Value = 2
-Range("C192").Value = num
-B192 = Range("B192").Value
-C192 = Range("C192").Value
-If B192 = C192 Then
-Range("D192").Value = "OK"
-Else
-Range("D192").Value = "NG"
-End If
-End Function
-
-Function test_xlListConflictError(ByRef num)
-Range("A193").Clear
-Range("B193").Clear
-Range("C193").Clear
-Range("D193").Clear
-Range("A193").Value = "xlListConflictError"
-Range("B193").Value = 3
-Range("C193").Value = num
-B193 = Range("B193").Value
-C193 = Range("C193").Value
-If B193 = C193 Then
-Range("D193").Value = "OK"
-Else
-Range("D193").Value = "NG"
-End If
-End Function
-
-Function test_xlListConflictRetryAllConflicts(ByRef num)
-Range("A194").Clear
-Range("B194").Clear
-Range("C194").Clear
-Range("D194").Clear
-Range("A194").Value = "xlListConflictRetryAllConflicts"
-Range("B194").Value = 1
-Range("C194").Value = num
-B194 = Range("B194").Value
-C194 = Range("C194").Value
-If B194 = C194 Then
-Range("D194").Value = "OK"
-Else
-Range("D194").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeCheckbox(ByRef num)
-Range("A195").Clear
-Range("B195").Clear
-Range("C195").Clear
-Range("D195").Clear
-Range("A195").Value = "xlListDataTypeCheckbox"
-Range("B195").Value = 9
-Range("C195").Value = num
-B195 = Range("B195").Value
-C195 = Range("C195").Value
-If B195 = C195 Then
-Range("D195").Value = "OK"
-Else
-Range("D195").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeChoice(ByRef num)
-Range("A196").Clear
-Range("B196").Clear
-Range("C196").Clear
-Range("D196").Clear
-Range("A196").Value = "xlListDataTypeChoice"
-Range("B196").Value = 6
-Range("C196").Value = num
-B196 = Range("B196").Value
-C196 = Range("C196").Value
-If B196 = C196 Then
-Range("D196").Value = "OK"
-Else
-Range("D196").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeChoiceMulti(ByRef num)
-Range("A197").Clear
-Range("B197").Clear
-Range("C197").Clear
-Range("D197").Clear
-Range("A197").Value = "xlListDataTypeChoiceMulti"
-Range("B197").Value = 7
-Range("C197").Value = num
-B197 = Range("B197").Value
-C197 = Range("C197").Value
-If B197 = C197 Then
-Range("D197").Value = "OK"
-Else
-Range("D197").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeCounter(ByRef num)
-Range("A198").Clear
-Range("B198").Clear
-Range("C198").Clear
-Range("D198").Clear
-Range("A198").Value = "xlListDataTypeCounter"
-Range("B198").Value = 11
-Range("C198").Value = num
-B198 = Range("B198").Value
-C198 = Range("C198").Value
-If B198 = C198 Then
-Range("D198").Value = "OK"
-Else
-Range("D198").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeCurrency(ByRef num)
-Range("A199").Clear
-Range("B199").Clear
-Range("C199").Clear
-Range("D199").Clear
-Range("A199").Value = "xlListDataTypeCurrency"
-Range("B199").Value = 4
-Range("C199").Value = num
-B199 = Range("B199").Value
-C199 = Range("C199").Value
-If B199 = C199 Then
-Range("D199").Value = "OK"
-Else
-Range("D199").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeDateTime(ByRef num)
-Range("A200").Clear
-Range("B200").Clear
-Range("C200").Clear
-Range("D200").Clear
-Range("A200").Value = "xlListDataTypeDateTime"
-Range("B200").Value = 5
-Range("C200").Value = num
-B200 = Range("B200").Value
-C200 = Range("C200").Value
-If B200 = C200 Then
-Range("D200").Value = "OK"
-Else
-Range("D200").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeHyperLink(ByRef num)
-Range("A201").Clear
-Range("B201").Clear
-Range("C201").Clear
-Range("D201").Clear
-Range("A201").Value = "xlListDataTypeHyperLink"
-Range("B201").Value = 10
-Range("C201").Value = num
-B201 = Range("B201").Value
-C201 = Range("C201").Value
-If B201 = C201 Then
-Range("D201").Value = "OK"
-Else
-Range("D201").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeListLookup(ByRef num)
-Range("A202").Clear
-Range("B202").Clear
-Range("C202").Clear
-Range("D202").Clear
-Range("A202").Value = "xlListDataTypeListLookup"
-Range("B202").Value = 8
-Range("C202").Value = num
-B202 = Range("B202").Value
-C202 = Range("C202").Value
-If B202 = C202 Then
-Range("D202").Value = "OK"
-Else
-Range("D202").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeMultiLineRichText(ByRef num)
-Range("A203").Clear
-Range("B203").Clear
-Range("C203").Clear
-Range("D203").Clear
-Range("A203").Value = "xlListDataTypeMultiLineRichText"
-Range("B203").Value = 12
-Range("C203").Value = num
-B203 = Range("B203").Value
-C203 = Range("C203").Value
-If B203 = C203 Then
-Range("D203").Value = "OK"
-Else
-Range("D203").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeMultiLineText(ByRef num)
-Range("A204").Clear
-Range("B204").Clear
-Range("C204").Clear
-Range("D204").Clear
-Range("A204").Value = "xlListDataTypeMultiLineText"
-Range("B204").Value = 2
-Range("C204").Value = num
-B204 = Range("B204").Value
-C204 = Range("C204").Value
-If B204 = C204 Then
-Range("D204").Value = "OK"
-Else
-Range("D204").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeNone(ByRef num)
-Range("A205").Clear
-Range("B205").Clear
-Range("C205").Clear
-Range("D205").Clear
-Range("A205").Value = "xlListDataTypeNone"
-Range("B205").Value = 0
-Range("C205").Value = num
-B205 = Range("B205").Value
-C205 = Range("C205").Value
-If B205 = C205 Then
-Range("D205").Value = "OK"
-Else
-Range("D205").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeNumber(ByRef num)
-Range("A206").Clear
-Range("B206").Clear
-Range("C206").Clear
-Range("D206").Clear
-Range("A206").Value = "xlListDataTypeNumber"
-Range("B206").Value = 3
-Range("C206").Value = num
-B206 = Range("B206").Value
-C206 = Range("C206").Value
-If B206 = C206 Then
-Range("D206").Value = "OK"
-Else
-Range("D206").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeText(ByRef num)
-Range("A207").Clear
-Range("B207").Clear
-Range("C207").Clear
-Range("D207").Clear
-Range("A207").Value = "xlListDataTypeText"
-Range("B207").Value = 1
-Range("C207").Value = num
-B207 = Range("B207").Value
-C207 = Range("C207").Value
-If B207 = C207 Then
-Range("D207").Value = "OK"
-Else
-Range("D207").Value = "NG"
-End If
-End Function
-
-Function test_xlSrcExternal(ByRef num)
-Range("A208").Clear
-Range("B208").Clear
-Range("C208").Clear
-Range("D208").Clear
-Range("A208").Value = "xlSrcExternal"
-Range("B208").Value = 0
-Range("C208").Value = num
-B208 = Range("B208").Value
-C208 = Range("C208").Value
-If B208 = C208 Then
-Range("D208").Value = "OK"
-Else
-Range("D208").Value = "NG"
-End If
-End Function
-
-Function test_xlSrcRange(ByRef num)
-Range("A209").Clear
-Range("B209").Clear
-Range("C209").Clear
-Range("D209").Clear
-Range("A209").Value = "xlSrcRange"
-Range("B209").Value = 1
-Range("C209").Value = num
-B209 = Range("B209").Value
-C209 = Range("C209").Value
-If B209 = C209 Then
-Range("D209").Value = "OK"
-Else
-Range("D209").Value = "NG"
-End If
-End Function
-
-Function test_xlSrcXml(ByRef num)
-Range("A210").Clear
-Range("B210").Clear
-Range("C210").Clear
-Range("D210").Clear
-Range("A210").Value = "xlSrcXml"
-Range("B210").Value = 2
-Range("C210").Value = num
-B210 = Range("B210").Value
-C210 = Range("C210").Value
-If B210 = C210 Then
-Range("D210").Value = "OK"
-Else
-Range("D210").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnHeader(ByRef num)
-Range("A211").Clear
-Range("B211").Clear
-Range("C211").Clear
-Range("D211").Clear
-Range("A211").Value = "xlColumnHeader"
-Range("B211").Value = -4110
-Range("C211").Value = num
-B211 = Range("B211").Value
-C211 = Range("C211").Value
-If B211 = C211 Then
-Range("D211").Value = "OK"
-Else
-Range("D211").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnItem(ByRef num)
-Range("A212").Clear
-Range("B212").Clear
-Range("C212").Clear
-Range("D212").Clear
-Range("A212").Value = "xlColumnItem"
-Range("B212").Value = 5
-Range("C212").Value = num
-B212 = Range("B212").Value
-C212 = Range("C212").Value
-If B212 = C212 Then
-Range("D212").Value = "OK"
-Else
-Range("D212").Value = "NG"
-End If
-End Function
-
-Function test_xlDataHeader(ByRef num)
-Range("A213").Clear
-Range("B213").Clear
-Range("C213").Clear
-Range("D213").Clear
-Range("A213").Value = "xlDataHeader"
-Range("B213").Value = 3
-Range("C213").Value = num
-B213 = Range("B213").Value
-C213 = Range("C213").Value
-If B213 = C213 Then
-Range("D213").Value = "OK"
-Else
-Range("D213").Value = "NG"
-End If
-End Function
-
-Function test_xlDataItem(ByRef num)
-Range("A214").Clear
-Range("B214").Clear
-Range("C214").Clear
-Range("D214").Clear
-Range("A214").Value = "xlDataItem"
-Range("B214").Value = 7
-Range("C214").Value = num
-B214 = Range("B214").Value
-C214 = Range("C214").Value
-If B214 = C214 Then
-Range("D214").Value = "OK"
-Else
-Range("D214").Value = "NG"
-End If
-End Function
-
-Function test_xlPageHeader(ByRef num)
-Range("A215").Clear
-Range("B215").Clear
-Range("C215").Clear
-Range("D215").Clear
-Range("A215").Value = "xlPageHeader"
-Range("B215").Value = 2
-Range("C215").Value = num
-B215 = Range("B215").Value
-C215 = Range("C215").Value
-If B215 = C215 Then
-Range("D215").Value = "OK"
-Else
-Range("D215").Value = "NG"
-End If
-End Function
-
-Function test_xlPageItem(ByRef num)
-Range("A216").Clear
-Range("B216").Clear
-Range("C216").Clear
-Range("D216").Clear
-Range("A216").Value = "xlPageItem"
-Range("B216").Value = 6
-Range("C216").Value = num
-B216 = Range("B216").Value
-C216 = Range("C216").Value
-If B216 = C216 Then
-Range("D216").Value = "OK"
-Else
-Range("D216").Value = "NG"
-End If
-End Function
-
-Function test_xlRowHeader(ByRef num)
-Range("A217").Clear
-Range("B217").Clear
-Range("C217").Clear
-Range("D217").Clear
-Range("A217").Value = "xlRowHeader"
-Range("B217").Value = -4153
-Range("C217").Value = num
-B217 = Range("B217").Value
-C217 = Range("C217").Value
-If B217 = C217 Then
-Range("D217").Value = "OK"
-Else
-Range("D217").Value = "NG"
-End If
-End Function
-
-Function test_xlRowItem(ByRef num)
-Range("A218").Clear
-Range("B218").Clear
-Range("C218").Clear
-Range("D218").Clear
-Range("A218").Value = "xlRowItem"
-Range("B218").Value = 4
-Range("C218").Value = num
-B218 = Range("B218").Value
-C218 = Range("C218").Value
-If B218 = C218 Then
-Range("D218").Value = "OK"
-Else
-Range("D218").Value = "NG"
-End If
-End Function
-
-Function test_xlTableBody(ByRef num)
-Range("A219").Clear
-Range("B219").Clear
-Range("C219").Clear
-Range("D219").Clear
-Range("A219").Value = "xlTableBody"
-Range("B219").Value = 8
-Range("C219").Value = num
-B219 = Range("B219").Value
-C219 = Range("C219").Value
-If B219 = C219 Then
-Range("D219").Value = "OK"
-Else
-Range("D219").Value = "NG"
-End If
-End Function
-
-Function test_xlPart(ByRef num)
-Range("A220").Clear
-Range("B220").Clear
-Range("C220").Clear
-Range("D220").Clear
-Range("A220").Value = "xlPart"
-Range("B220").Value = 2
-Range("C220").Value = num
-B220 = Range("B220").Value
-C220 = Range("C220").Value
-If B220 = C220 Then
-Range("D220").Value = "OK"
-Else
-Range("D220").Value = "NG"
-End If
-End Function
-
-Function test_xlWhole(ByRef num)
-Range("A221").Clear
-Range("B221").Clear
-Range("C221").Clear
-Range("D221").Clear
-Range("A221").Value = "xlWhole"
-Range("B221").Value = 1
-Range("C221").Value = num
-B221 = Range("B221").Value
-C221 = Range("C221").Value
-If B221 = C221 Then
-Range("D221").Value = "OK"
-Else
-Range("D221").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftAccess(ByRef num)
-Range("A222").Clear
-Range("B222").Clear
-Range("C222").Clear
-Range("D222").Clear
-Range("A222").Value = "xlMicrosoftAccess"
-Range("B222").Value = 4
-Range("C222").Value = num
-B222 = Range("B222").Value
-C222 = Range("C222").Value
-If B222 = C222 Then
-Range("D222").Value = "OK"
-Else
-Range("D222").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftFoxPro(ByRef num)
-Range("A223").Clear
-Range("B223").Clear
-Range("C223").Clear
-Range("D223").Clear
-Range("A223").Value = "xlMicrosoftFoxPro"
-Range("B223").Value = 5
-Range("C223").Value = num
-B223 = Range("B223").Value
-C223 = Range("C223").Value
-If B223 = C223 Then
-Range("D223").Value = "OK"
-Else
-Range("D223").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftMail(ByRef num)
-Range("A224").Clear
-Range("B224").Clear
-Range("C224").Clear
-Range("D224").Clear
-Range("A224").Value = "xlMicrosoftMail"
-Range("B224").Value = 3
-Range("C224").Value = num
-B224 = Range("B224").Value
-C224 = Range("C224").Value
-If B224 = C224 Then
-Range("D224").Value = "OK"
-Else
-Range("D224").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftPowerPoint(ByRef num)
-Range("A225").Clear
-Range("B225").Clear
-Range("C225").Clear
-Range("D225").Clear
-Range("A225").Value = "xlMicrosoftPowerPoint"
-Range("B225").Value = 2
-Range("C225").Value = num
-B225 = Range("B225").Value
-C225 = Range("C225").Value
-If B225 = C225 Then
-Range("D225").Value = "OK"
-Else
-Range("D225").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftProject(ByRef num)
-Range("A226").Clear
-Range("B226").Clear
-Range("C226").Clear
-Range("D226").Clear
-Range("A226").Value = "xlMicrosoftProject"
-Range("B226").Value = 6
-Range("C226").Value = num
-B226 = Range("B226").Value
-C226 = Range("C226").Value
-If B226 = C226 Then
-Range("D226").Value = "OK"
-Else
-Range("D226").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftSchedulePlus(ByRef num)
-Range("A227").Clear
-Range("B227").Clear
-Range("C227").Clear
-Range("D227").Clear
-Range("A227").Value = "xlMicrosoftSchedulePlus"
-Range("B227").Value = 7
-Range("C227").Value = num
-B227 = Range("B227").Value
-C227 = Range("C227").Value
-If B227 = C227 Then
-Range("D227").Value = "OK"
-Else
-Range("D227").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftWord(ByRef num)
-Range("A228").Clear
-Range("B228").Clear
-Range("C228").Clear
-Range("D228").Clear
-Range("A228").Value = "xlMicrosoftWord"
-Range("B228").Value = 1
-Range("C228").Value = num
-B228 = Range("B228").Value
-C228 = Range("C228").Value
-If B228 = C228 Then
-Range("D228").Value = "OK"
-Else
-Range("D228").Value = "NG"
-End If
-End Function
-
-Function test_xlMAPI(ByRef num)
-Range("A229").Clear
-Range("B229").Clear
-Range("C229").Clear
-Range("D229").Clear
-Range("A229").Value = "xlMAPI"
-Range("B229").Value = 1
-Range("C229").Value = num
-B229 = Range("B229").Value
-C229 = Range("C229").Value
-If B229 = C229 Then
-Range("D229").Value = "OK"
-Else
-Range("D229").Value = "NG"
-End If
-End Function
-
-Function test_xlNoMailSystem(ByRef num)
-Range("A230").Clear
-Range("B230").Clear
-Range("C230").Clear
-Range("D230").Clear
-Range("A230").Value = "xlNoMailSystem"
-Range("B230").Value = 0
-Range("C230").Value = num
-B230 = Range("B230").Value
-C230 = Range("C230").Value
-If B230 = C230 Then
-Range("D230").Value = "OK"
-Else
-Range("D230").Value = "NG"
-End If
-End Function
-
-Function test_xlPowerTalk(ByRef num)
-Range("A231").Clear
-Range("B231").Clear
-Range("C231").Clear
-Range("D231").Clear
-Range("A231").Value = "xlPowerTalk"
-Range("B231").Value = 2
-Range("C231").Value = num
-B231 = Range("B231").Value
-C231 = Range("C231").Value
-If B231 = C231 Then
-Range("D231").Value = "OK"
-Else
-Range("D231").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleAutomatic(ByRef num)
-Range("A232").Clear
-Range("B232").Clear
-Range("C232").Clear
-Range("D232").Clear
-Range("A232").Value = "xlMarkerStyleAutomatic"
-Range("B232").Value = -4105
-Range("C232").Value = num
-B232 = Range("B232").Value
-C232 = Range("C232").Value
-If B232 = C232 Then
-Range("D232").Value = "OK"
-Else
-Range("D232").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleCircle(ByRef num)
-Range("A233").Clear
-Range("B233").Clear
-Range("C233").Clear
-Range("D233").Clear
-Range("A233").Value = "xlMarkerStyleCircle"
-Range("B233").Value = 8
-Range("C233").Value = num
-B233 = Range("B233").Value
-C233 = Range("C233").Value
-If B233 = C233 Then
-Range("D233").Value = "OK"
-Else
-Range("D233").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleDash(ByRef num)
-Range("A234").Clear
-Range("B234").Clear
-Range("C234").Clear
-Range("D234").Clear
-Range("A234").Value = "xlMarkerStyleDash"
-Range("B234").Value = -4115
-Range("C234").Value = num
-B234 = Range("B234").Value
-C234 = Range("C234").Value
-If B234 = C234 Then
-Range("D234").Value = "OK"
-Else
-Range("D234").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleDiamond(ByRef num)
-Range("A235").Clear
-Range("B235").Clear
-Range("C235").Clear
-Range("D235").Clear
-Range("A235").Value = "xlMarkerStyleDiamond"
-Range("B235").Value = 2
-Range("C235").Value = num
-B235 = Range("B235").Value
-C235 = Range("C235").Value
-If B235 = C235 Then
-Range("D235").Value = "OK"
-Else
-Range("D235").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleDot(ByRef num)
-Range("A236").Clear
-Range("B236").Clear
-Range("C236").Clear
-Range("D236").Clear
-Range("A236").Value = "xlMarkerStyleDot"
-Range("B236").Value = -4118
-Range("C236").Value = num
-B236 = Range("B236").Value
-C236 = Range("C236").Value
-If B236 = C236 Then
-Range("D236").Value = "OK"
-Else
-Range("D236").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleNone(ByRef num)
-Range("A237").Clear
-Range("B237").Clear
-Range("C237").Clear
-Range("D237").Clear
-Range("A237").Value = "xlMarkerStyleNone"
-Range("B237").Value = -4142
-Range("C237").Value = num
-B237 = Range("B237").Value
-C237 = Range("C237").Value
-If B237 = C237 Then
-Range("D237").Value = "OK"
-Else
-Range("D237").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStylePicture(ByRef num)
-Range("A238").Clear
-Range("B238").Clear
-Range("C238").Clear
-Range("D238").Clear
-Range("A238").Value = "xlMarkerStylePicture"
-Range("B238").Value = -4147
-Range("C238").Value = num
-B238 = Range("B238").Value
-C238 = Range("C238").Value
-If B238 = C238 Then
-Range("D238").Value = "OK"
-Else
-Range("D238").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStylePlus(ByRef num)
-Range("A239").Clear
-Range("B239").Clear
-Range("C239").Clear
-Range("D239").Clear
-Range("A239").Value = "xlMarkerStylePlus"
-Range("B239").Value = 9
-Range("C239").Value = num
-B239 = Range("B239").Value
-C239 = Range("C239").Value
-If B239 = C239 Then
-Range("D239").Value = "OK"
-Else
-Range("D239").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleSquare(ByRef num)
-Range("A240").Clear
-Range("B240").Clear
-Range("C240").Clear
-Range("D240").Clear
-Range("A240").Value = "xlMarkerStyleSquare"
-Range("B240").Value = 1
-Range("C240").Value = num
-B240 = Range("B240").Value
-C240 = Range("C240").Value
-If B240 = C240 Then
-Range("D240").Value = "OK"
-Else
-Range("D240").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleStar(ByRef num)
-Range("A241").Clear
-Range("B241").Clear
-Range("C241").Clear
-Range("D241").Clear
-Range("A241").Value = "xlMarkerStyleStar"
-Range("B241").Value = 5
-Range("C241").Value = num
-B241 = Range("B241").Value
-C241 = Range("C241").Value
-If B241 = C241 Then
-Range("D241").Value = "OK"
-Else
-Range("D241").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleTiangle(ByRef num)
-Range("A242").Clear
-Range("B242").Clear
-Range("C242").Clear
-Range("D242").Clear
-Range("A242").Value = "xlMarkerStyleTiangle"
-Range("B242").Value = 3
-Range("C242").Value = num
-B242 = Range("B242").Value
-C242 = Range("C242").Value
-If B242 = C242 Then
-Range("D242").Value = "OK"
-Else
-Range("D242").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleX(ByRef num)
-Range("A243").Clear
-Range("B243").Clear
-Range("C243").Clear
-Range("D243").Clear
-Range("A243").Value = "xlMarkerStyleX"
-Range("B243").Value = -4168
-Range("C243").Value = num
-B243 = Range("B243").Value
-C243 = Range("C243").Value
-If B243 = C243 Then
-Range("D243").Value = "OK"
-Else
-Range("D243").Value = "NG"
-End If
-End Function
-
-Function test_xlNoButton(ByRef num)
-Range("A244").Clear
-Range("B244").Clear
-Range("C244").Clear
-Range("D244").Clear
-Range("A244").Value = "xlNoButton"
-Range("B244").Value = 0
-Range("C244").Value = num
-B244 = Range("B244").Value
-C244 = Range("C244").Value
-If B244 = C244 Then
-Range("D244").Value = "OK"
-Else
-Range("D244").Value = "NG"
-End If
-End Function
-
-Function test_xlPrimaryButton(ByRef num)
-Range("A245").Clear
-Range("B245").Clear
-Range("C245").Clear
-Range("D245").Clear
-Range("A245").Value = "xlPrimaryButton"
-Range("B245").Value = 1
-Range("C245").Value = num
-B245 = Range("B245").Value
-C245 = Range("C245").Value
-If B245 = C245 Then
-Range("D245").Value = "OK"
-Else
-Range("D245").Value = "NG"
-End If
-End Function
-
-Function test_xlSecondaryButton(ByRef num)
-Range("A246").Clear
-Range("B246").Clear
-Range("C246").Clear
-Range("D246").Clear
-Range("A246").Value = "xlSecondaryButton"
-Range("B246").Value = 2
-Range("C246").Value = num
-B246 = Range("B246").Value
-C246 = Range("C246").Value
-If B246 = C246 Then
-Range("D246").Value = "OK"
-Else
-Range("D246").Value = "NG"
-End If
-End Function
-
-Function test_xlDefault(ByRef num)
-Range("A247").Clear
-Range("B247").Clear
-Range("C247").Clear
-Range("D247").Clear
-Range("A247").Value = "xlDefault"
-Range("B247").Value = -4143
-Range("C247").Value = num
-B247 = Range("B247").Value
-C247 = Range("C247").Value
-If B247 = C247 Then
-Range("D247").Value = "OK"
-Else
-Range("D247").Value = "NG"
-End If
-End Function
-
-Function test_xlIBeam(ByRef num)
-Range("A248").Clear
-Range("B248").Clear
-Range("C248").Clear
-Range("D248").Clear
-Range("A248").Value = "xlIBeam"
-Range("B248").Value = 3
-Range("C248").Value = num
-B248 = Range("B248").Value
-C248 = Range("C248").Value
-If B248 = C248 Then
-Range("D248").Value = "OK"
-Else
-Range("D248").Value = "NG"
-End If
-End Function
-
-Function test_xlNorthwestArrow(ByRef num)
-Range("A249").Clear
-Range("B249").Clear
-Range("C249").Clear
-Range("D249").Clear
-Range("A249").Value = "xlNorthwestArrow"
-Range("B249").Value = 1
-Range("C249").Value = num
-B249 = Range("B249").Value
-C249 = Range("C249").Value
-If B249 = C249 Then
-Range("D249").Value = "OK"
-Else
-Range("D249").Value = "NG"
-End If
-End Function
-
-Function test_xlWait(ByRef num)
-Range("A250").Clear
-Range("B250").Clear
-Range("C250").Clear
-Range("D250").Clear
-Range("A250").Value = "xlWait"
-Range("B250").Value = 2
-Range("C250").Value = num
-B250 = Range("B250").Value
-C250 = Range("C250").Value
-If B250 = C250 Then
-Range("D250").Value = "OK"
-Else
-Range("D250").Value = "NG"
-End If
-End Function
-
-Function test_XlOLEControl(ByRef num)
-Range("A251").Clear
-Range("B251").Clear
-Range("C251").Clear
-Range("D251").Clear
-Range("A251").Value = "XlOLEControl"
-Range("B251").Value = 2
-Range("C251").Value = num
-B251 = Range("B251").Value
-C251 = Range("C251").Value
-If B251 = C251 Then
-Range("D251").Value = "OK"
-Else
-Range("D251").Value = "NG"
-End If
-End Function
-
-Function test_XlOLEEmbed(ByRef num)
-Range("A252").Clear
-Range("B252").Clear
-Range("C252").Clear
-Range("D252").Clear
-Range("A252").Value = "XlOLEEmbed"
-Range("B252").Value = 1
-Range("C252").Value = num
-B252 = Range("B252").Value
-C252 = Range("C252").Value
-If B252 = C252 Then
-Range("D252").Value = "OK"
-Else
-Range("D252").Value = "NG"
-End If
-End Function
-
-
-
-Function test_XlVerbOpen(ByRef num)
-Range("A254").Clear
-Range("B254").Clear
-Range("C254").Clear
-Range("D254").Clear
-Range("A254").Value = "XlVerbOpen"
-Range("B254").Value = 2
-Range("C254").Value = num
-B254 = Range("B254").Value
-C254 = Range("C254").Value
-If B254 = C254 Then
-Range("D254").Value = "OK"
-Else
-Range("D254").Value = "NG"
-End If
-End Function
-
-Function test_XlVerbPrimary(ByRef num)
-Range("A255").Clear
-Range("B255").Clear
-Range("C255").Clear
-Range("D255").Clear
-Range("A255").Value = "XlVerbPrimary"
-Range("B255").Value = 1
-Range("C255").Value = num
-B255 = Range("B255").Value
-C255 = Range("C255").Value
-If B255 = C255 Then
-Range("D255").Value = "OK"
-Else
-Range("D255").Value = "NG"
-End If
-End Function
-
-Function test_xlFitToPage(ByRef num)
-Range("A256").Clear
-Range("B256").Clear
-Range("C256").Clear
-Range("D256").Clear
-Range("A256").Value = "xlFitToPage"
-Range("B256").Value = 2
-Range("C256").Value = num
-B256 = Range("B256").Value
-C256 = Range("C256").Value
-If B256 = C256 Then
-Range("D256").Value = "OK"
-Else
-Range("D256").Value = "NG"
-End If
-End Function
-
-Function test_xlFullPage(ByRef num)
-Range("A257").Clear
-Range("B257").Clear
-Range("C257").Clear
-Range("D257").Clear
-Range("A257").Value = "xlFullPage"
-Range("B257").Value = 3
-Range("C257").Value = num
-B257 = Range("B257").Value
-C257 = Range("C257").Value
-If B257 = C257 Then
-Range("D257").Value = "OK"
-Else
-Range("D257").Value = "NG"
-End If
-End Function
-
-Function test_xlScreenSize(ByRef num)
-Range("A258").Clear
-Range("B258").Clear
-Range("C258").Clear
-Range("D258").Clear
-Range("A258").Value = "xlScreenSize"
-Range("B258").Value = 1
-Range("C258").Value = num
-B258 = Range("B258").Value
-C258 = Range("C258").Value
-If B258 = C258 Then
-Range("D258").Value = "OK"
-Else
-Range("D258").Value = "NG"
-End If
-End Function
-
-Function test_xlDownThenOver(ByRef num)
-Range("A259").Clear
-Range("B259").Clear
-Range("C259").Clear
-Range("D259").Clear
-Range("A259").Value = "xlDownThenOver"
-Range("B259").Value = 1
-Range("C259").Value = num
-B259 = Range("B259").Value
-C259 = Range("C259").Value
-If B259 = C259 Then
-Range("D259").Value = "OK"
-Else
-Range("D259").Value = "NG"
-End If
-End Function
-
-Function test_xlOverThenDown(ByRef num)
-Range("A260").Clear
-Range("B260").Clear
-Range("C260").Clear
-Range("D260").Clear
-Range("A260").Value = "xlOverThenDown"
-Range("B260").Value = 2
-Range("C260").Value = num
-B260 = Range("B260").Value
-C260 = Range("C260").Value
-If B260 = C260 Then
-Range("D260").Value = "OK"
-Else
-Range("D260").Value = "NG"
-End If
-End Function
-
-Function test_xlDownward(ByRef num)
-Range("A261").Clear
-Range("B261").Clear
-Range("C261").Clear
-Range("D261").Clear
-Range("A261").Value = "xlDownward"
-Range("B261").Value = -4170
-Range("C261").Value = num
-B261 = Range("B261").Value
-C261 = Range("C261").Value
-If B261 = C261 Then
-Range("D261").Value = "OK"
-Else
-Range("D261").Value = "NG"
-End If
-End Function
-
-Function test_xlHorizontal(ByRef num)
-Range("A262").Clear
-Range("B262").Clear
-Range("C262").Clear
-Range("D262").Clear
-Range("A262").Value = "xlHorizontal"
-Range("B262").Value = -4128
-Range("C262").Value = num
-B262 = Range("B262").Value
-C262 = Range("C262").Value
-If B262 = C262 Then
-Range("D262").Value = "OK"
-Else
-Range("D262").Value = "NG"
-End If
-End Function
-
-Function test_xlUpward(ByRef num)
-Range("A263").Clear
-Range("B263").Clear
-Range("C263").Clear
-Range("D263").Clear
-Range("A263").Value = "xlUpward"
-Range("B263").Value = -4171
-Range("C263").Value = num
-B263 = Range("B263").Value
-C263 = Range("C263").Value
-If B263 = C263 Then
-Range("D263").Value = "OK"
-Else
-Range("D263").Value = "NG"
-End If
-End Function
-
-Function test_xlVertical(ByRef num)
-Range("A264").Clear
-Range("B264").Clear
-Range("C264").Clear
-Range("D264").Clear
-Range("A264").Value = "xlVertical"
-Range("B264").Value = -4166
-Range("C264").Value = num
-B264 = Range("B264").Value
-C264 = Range("C264").Value
-If B264 = C264 Then
-Range("D264").Value = "OK"
-Else
-Range("D264").Value = "NG"
-End If
-End Function
-
-Function test_xlBlanks(ByRef num)
-Range("A265").Clear
-Range("B265").Clear
-Range("C265").Clear
-Range("D265").Clear
-Range("A265").Value = "xlBlanks"
-Range("B265").Value = 4
-Range("C265").Value = num
-B265 = Range("B265").Value
-C265 = Range("C265").Value
-If B265 = C265 Then
-Range("D265").Value = "OK"
-Else
-Range("D265").Value = "NG"
-End If
-End Function
-
-Function test_xlButton(ByRef num)
-Range("A266").Clear
-Range("B266").Clear
-Range("C266").Clear
-Range("D266").Clear
-Range("A266").Value = "xlButton"
-Range("B266").Value = 15
-Range("C266").Value = num
-B266 = Range("B266").Value
-C266 = Range("C266").Value
-If B266 = C266 Then
-Range("D266").Value = "OK"
-Else
-Range("D266").Value = "NG"
-End If
-End Function
-
-Function test_xlDataAndLabel(ByRef num)
-Range("A267").Clear
-Range("B267").Clear
-Range("C267").Clear
-Range("D267").Clear
-Range("A267").Value = "xlDataAndLabel"
-Range("B267").Value = 0
-Range("C267").Value = num
-B267 = Range("B267").Value
-C267 = Range("C267").Value
-If B267 = C267 Then
-Range("D267").Value = "OK"
-Else
-Range("D267").Value = "NG"
-End If
-End Function
-
-Function test_xlDataOnly(ByRef num)
-Range("A268").Clear
-Range("B268").Clear
-Range("C268").Clear
-Range("D268").Clear
-Range("A268").Value = "xlDataOnly"
-Range("B268").Value = 2
-Range("C268").Value = num
-B268 = Range("B268").Value
-C268 = Range("C268").Value
-If B268 = C268 Then
-Range("D268").Value = "OK"
-Else
-Range("D268").Value = "NG"
-End If
-End Function
-
-Function test_xlFirstRow(ByRef num)
-Range("A269").Clear
-Range("B269").Clear
-Range("C269").Clear
-Range("D269").Clear
-Range("A269").Value = "xlFirstRow"
-Range("B269").Value = 256
-Range("C269").Value = num
-B269 = Range("B269").Value
-C269 = Range("C269").Value
-If B269 = C269 Then
-Range("D269").Value = "OK"
-Else
-Range("D269").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelOnly(ByRef num)
-Range("A270").Clear
-Range("B270").Clear
-Range("C270").Clear
-Range("D270").Clear
-Range("A270").Value = "xlLabelOnly"
-Range("B270").Value = 1
-Range("C270").Value = num
-B270 = Range("B270").Value
-C270 = Range("C270").Value
-If B270 = C270 Then
-Range("D270").Value = "OK"
-Else
-Range("D270").Value = "NG"
-End If
-End Function
-
-Function test_xlOrigin(ByRef num)
-Range("A271").Clear
-Range("B271").Clear
-Range("C271").Clear
-Range("D271").Clear
-Range("A271").Value = "xlOrigin"
-Range("B271").Value = 3
-Range("C271").Value = num
-B271 = Range("B271").Value
-C271 = Range("C271").Value
-If B271 = C271 Then
-Range("D271").Value = "OK"
-Else
-Range("D271").Value = "NG"
-End If
-End Function
-
-Function test_XlPageBreakAutomatic(ByRef num)
-Range("A272").Clear
-Range("B272").Clear
-Range("C272").Clear
-Range("D272").Clear
-Range("A272").Value = "XlPageBreakAutomatic"
-Range("B272").Value = -4105
-Range("C272").Value = num
-B272 = Range("B272").Value
-C272 = Range("C272").Value
-If B272 = C272 Then
-Range("D272").Value = "OK"
-Else
-Range("D272").Value = "NG"
-End If
-End Function
-
-Function test_XlPageBreakManual(ByRef num)
-Range("A273").Clear
-Range("B273").Clear
-Range("C273").Clear
-Range("D273").Clear
-Range("A273").Value = "XlPageBreakManual"
-Range("B273").Value = -4135
-Range("C273").Value = num
-B273 = Range("B273").Value
-C273 = Range("C273").Value
-If B273 = C273 Then
-Range("D273").Value = "OK"
-Else
-Range("D273").Value = "NG"
-End If
-End Function
-
-Function test_XlPageBreakNone(ByRef num)
-Range("A274").Clear
-Range("B274").Clear
-Range("C274").Clear
-Range("D274").Clear
-Range("A274").Value = "XlPageBreakNone"
-Range("B274").Value = -4142
-Range("C274").Value = num
-B274 = Range("B274").Value
-C274 = Range("C274").Value
-If B274 = C274 Then
-Range("D274").Value = "OK"
-Else
-Range("D274").Value = "NG"
-End If
-End Function
-
-Function test_xlPageBreakFull(ByRef num)
-Range("A275").Clear
-Range("B275").Clear
-Range("C275").Clear
-Range("D275").Clear
-Range("A275").Value = "xlPageBreakFull"
-Range("B275").Value = 1
-Range("C275").Value = num
-B275 = Range("B275").Value
-C275 = Range("C275").Value
-If B275 = C275 Then
-Range("D275").Value = "OK"
-Else
-Range("D275").Value = "NG"
-End If
-End Function
-
-Function test_xlPageBreakPartial(ByRef num)
-Range("A276").Clear
-Range("B276").Clear
-Range("C276").Clear
-Range("D276").Clear
-Range("A276").Value = "xlPageBreakPartial"
-Range("B276").Value = 2
-Range("C276").Value = num
-B276 = Range("B276").Value
-C276 = Range("C276").Value
-If B276 = C276 Then
-Range("D276").Value = "OK"
-Else
-Range("D276").Value = "NG"
-End If
-End Function
-
-Function test_xlLandscape(ByRef num)
-Range("A277").Clear
-Range("B277").Clear
-Range("C277").Clear
-Range("D277").Clear
-Range("A277").Value = "xlLandscape"
-Range("B277").Value = 2
-Range("C277").Value = num
-B277 = Range("B277").Value
-C277 = Range("C277").Value
-If B277 = C277 Then
-Range("D277").Value = "OK"
-Else
-Range("D277").Value = "NG"
-End If
-End Function
-
-Function test_xlPortrait(ByRef num)
-Range("A278").Clear
-Range("B278").Clear
-Range("C278").Clear
-Range("D278").Clear
-Range("A278").Value = "xlPortrait"
-Range("B278").Value = 1
-Range("C278").Value = num
-B278 = Range("B278").Value
-C278 = Range("C278").Value
-If B278 = C278 Then
-Range("D278").Value = "OK"
-Else
-Range("D278").Value = "NG"
-End If
-End Function
-
-Function test_xlPaper10x14(ByRef num)
-Range("A279").Clear
-Range("B279").Clear
-Range("C279").Clear
-Range("D279").Clear
-Range("A279").Value = "xlPaper10x14"
-Range("B279").Value = 16
-Range("C279").Value = num
-B279 = Range("B279").Value
-C279 = Range("C279").Value
-If B279 = C279 Then
-Range("D279").Value = "OK"
-Else
-Range("D279").Value = "NG"
-End If
-End Function
-
-Function test_xlPaper11x17(ByRef num)
-Range("A280").Clear
-Range("B280").Clear
-Range("C280").Clear
-Range("D280").Clear
-Range("A280").Value = "xlPaper11x17"
-Range("B280").Value = 17
-Range("C280").Value = num
-B280 = Range("B280").Value
-C280 = Range("C280").Value
-If B280 = C280 Then
-Range("D280").Value = "OK"
-Else
-Range("D280").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperA3(ByRef num)
-Range("A281").Clear
-Range("B281").Clear
-Range("C281").Clear
-Range("D281").Clear
-Range("A281").Value = "xlPaperA3"
-Range("B281").Value = 8
-Range("C281").Value = num
-B281 = Range("B281").Value
-C281 = Range("C281").Value
-If B281 = C281 Then
-Range("D281").Value = "OK"
-Else
-Range("D281").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperA4Small(ByRef num)
-Range("A282").Clear
-Range("B282").Clear
-Range("C282").Clear
-Range("D282").Clear
-Range("A282").Value = "xlPaperA4Small"
-Range("B282").Value = 9
-Range("C282").Value = num
-B282 = Range("B282").Value
-C282 = Range("C282").Value
-If B282 = C282 Then
-Range("D282").Value = "OK"
-Else
-Range("D282").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperA5(ByRef num)
-Range("A283").Clear
-Range("B283").Clear
-Range("C283").Clear
-Range("D283").Clear
-Range("A283").Value = "xlPaperA5"
-Range("B283").Value = 10
-Range("C283").Value = num
-B283 = Range("B283").Value
-C283 = Range("C283").Value
-If B283 = C283 Then
-Range("D283").Value = "OK"
-Else
-Range("D283").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperB4(ByRef num)
-Range("A284").Clear
-Range("B284").Clear
-Range("C284").Clear
-Range("D284").Clear
-Range("A284").Value = "xlPaperB4"
-Range("B284").Value = 12
-Range("C284").Value = num
-B284 = Range("B284").Value
-C284 = Range("C284").Value
-If B284 = C284 Then
-Range("D284").Value = "OK"
-Else
-Range("D284").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperB5(ByRef num)
-Range("A285").Clear
-Range("B285").Clear
-Range("C285").Clear
-Range("D285").Clear
-Range("A285").Value = "xlPaperB5"
-Range("B285").Value = 13
-Range("C285").Value = num
-B285 = Range("B285").Value
-C285 = Range("C285").Value
-If B285 = C285 Then
-Range("D285").Value = "OK"
-Else
-Range("D285").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperCsheet(ByRef num)
-Range("A286").Clear
-Range("B286").Clear
-Range("C286").Clear
-Range("D286").Clear
-Range("A286").Value = "xlPaperCsheet"
-Range("B286").Value = 24
-Range("C286").Value = num
-B286 = Range("B286").Value
-C286 = Range("C286").Value
-If B286 = C286 Then
-Range("D286").Value = "OK"
-Else
-Range("D286").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperDsheet(ByRef num)
-Range("A287").Clear
-Range("B287").Clear
-Range("C287").Clear
-Range("D287").Clear
-Range("A287").Value = "xlPaperDsheet"
-Range("B287").Value = 25
-Range("C287").Value = num
-B287 = Range("B287").Value
-C287 = Range("C287").Value
-If B287 = C287 Then
-Range("D287").Value = "OK"
-Else
-Range("D287").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelope10(ByRef num)
-Range("A288").Clear
-Range("B288").Clear
-Range("C288").Clear
-Range("D288").Clear
-Range("A288").Value = "xlPaperEnvelope10"
-Range("B288").Value = 20
-Range("C288").Value = num
-B288 = Range("B288").Value
-C288 = Range("C288").Value
-If B288 = C288 Then
-Range("D288").Value = "OK"
-Else
-Range("D288").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelope11(ByRef num)
-Range("A289").Clear
-Range("B289").Clear
-Range("C289").Clear
-Range("D289").Clear
-Range("A289").Value = "xlPaperEnvelope11"
-Range("B289").Value = 21
-Range("C289").Value = num
-B289 = Range("B289").Value
-C289 = Range("C289").Value
-If B289 = C289 Then
-Range("D289").Value = "OK"
-Else
-Range("D289").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelope12(ByRef num)
-Range("A290").Clear
-Range("B290").Clear
-Range("C290").Clear
-Range("D290").Clear
-Range("A290").Value = "xlPaperEnvelope12"
-Range("B290").Value = 22
-Range("C290").Value = num
-B290 = Range("B290").Value
-C290 = Range("C290").Value
-If B290 = C290 Then
-Range("D290").Value = "OK"
-Else
-Range("D290").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelope14(ByRef num)
-Range("A291").Clear
-Range("B291").Clear
-Range("C291").Clear
-Range("D291").Clear
-Range("A291").Value = "xlPaperEnvelope14"
-Range("B291").Value = 23
-Range("C291").Value = num
-B291 = Range("B291").Value
-C291 = Range("C291").Value
-If B291 = C291 Then
-Range("D291").Value = "OK"
-Else
-Range("D291").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelope9(ByRef num)
-Range("A292").Clear
-Range("B292").Clear
-Range("C292").Clear
-Range("D292").Clear
-Range("A292").Value = "xlPaperEnvelope9"
-Range("B292").Value = 19
-Range("C292").Value = num
-B292 = Range("B292").Value
-C292 = Range("C292").Value
-If B292 = C292 Then
-Range("D292").Value = "OK"
-Else
-Range("D292").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeB4(ByRef num)
-Range("A293").Clear
-Range("B293").Clear
-Range("C293").Clear
-Range("D293").Clear
-Range("A293").Value = "xlPaperEnvelopeB4"
-Range("B293").Value = 33
-Range("C293").Value = num
-B293 = Range("B293").Value
-C293 = Range("C293").Value
-If B293 = C293 Then
-Range("D293").Value = "OK"
-Else
-Range("D293").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeB5(ByRef num)
-Range("A294").Clear
-Range("B294").Clear
-Range("C294").Clear
-Range("D294").Clear
-Range("A294").Value = "xlPaperEnvelopeB5"
-Range("B294").Value = 34
-Range("C294").Value = num
-B294 = Range("B294").Value
-C294 = Range("C294").Value
-If B294 = C294 Then
-Range("D294").Value = "OK"
-Else
-Range("D294").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeB6(ByRef num)
-Range("A295").Clear
-Range("B295").Clear
-Range("C295").Clear
-Range("D295").Clear
-Range("A295").Value = "xlPaperEnvelopeB6"
-Range("B295").Value = 35
-Range("C295").Value = num
-B295 = Range("B295").Value
-C295 = Range("C295").Value
-If B295 = C295 Then
-Range("D295").Value = "OK"
-Else
-Range("D295").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeC3(ByRef num)
-Range("A296").Clear
-Range("B296").Clear
-Range("C296").Clear
-Range("D296").Clear
-Range("A296").Value = "xlPaperEnvelopeC3"
-Range("B296").Value = 29
-Range("C296").Value = num
-B296 = Range("B296").Value
-C296 = Range("C296").Value
-If B296 = C296 Then
-Range("D296").Value = "OK"
-Else
-Range("D296").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeC4(ByRef num)
-Range("A297").Clear
-Range("B297").Clear
-Range("C297").Clear
-Range("D297").Clear
-Range("A297").Value = "xlPaperEnvelopeC4"
-Range("B297").Value = 30
-Range("C297").Value = num
-B297 = Range("B297").Value
-C297 = Range("C297").Value
-If B297 = C297 Then
-Range("D297").Value = "OK"
-Else
-Range("D297").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeC5(ByRef num)
-Range("A298").Clear
-Range("B298").Clear
-Range("C298").Clear
-Range("D298").Clear
-Range("A298").Value = "xlPaperEnvelopeC5"
-Range("B298").Value = 28
-Range("C298").Value = num
-B298 = Range("B298").Value
-C298 = Range("C298").Value
-If B298 = C298 Then
-Range("D298").Value = "OK"
-Else
-Range("D298").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeC6(ByRef num)
-Range("A299").Clear
-Range("B299").Clear
-Range("C299").Clear
-Range("D299").Clear
-Range("A299").Value = "xlPaperEnvelopeC6"
-Range("B299").Value = 31
-Range("C299").Value = num
-B299 = Range("B299").Value
-C299 = Range("C299").Value
-If B299 = C299 Then
-Range("D299").Value = "OK"
-Else
-Range("D299").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeC65(ByRef num)
-Range("A300").Clear
-Range("B300").Clear
-Range("C300").Clear
-Range("D300").Clear
-Range("A300").Value = "xlPaperEnvelopeC65"
-Range("B300").Value = 32
-Range("C300").Value = num
-B300 = Range("B300").Value
-C300 = Range("C300").Value
-If B300 = C300 Then
-Range("D300").Value = "OK"
-Else
-Range("D300").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeDL(ByRef num)
-Range("A301").Clear
-Range("B301").Clear
-Range("C301").Clear
-Range("D301").Clear
-Range("A301").Value = "xlPaperEnvelopeDL"
-Range("B301").Value = 27
-Range("C301").Value = num
-B301 = Range("B301").Value
-C301 = Range("C301").Value
-If B301 = C301 Then
-Range("D301").Value = "OK"
-Else
-Range("D301").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeItaly(ByRef num)
-Range("A302").Clear
-Range("B302").Clear
-Range("C302").Clear
-Range("D302").Clear
-Range("A302").Value = "xlPaperEnvelopeItaly"
-Range("B302").Value = 36
-Range("C302").Value = num
-B302 = Range("B302").Value
-C302 = Range("C302").Value
-If B302 = C302 Then
-Range("D302").Value = "OK"
-Else
-Range("D302").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeMonarch(ByRef num)
-Range("A303").Clear
-Range("B303").Clear
-Range("C303").Clear
-Range("D303").Clear
-Range("A303").Value = "xlPaperEnvelopeMonarch"
-Range("B303").Value = 37
-Range("C303").Value = num
-B303 = Range("B303").Value
-C303 = Range("C303").Value
-If B303 = C303 Then
-Range("D303").Value = "OK"
-Else
-Range("D303").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopePersonal(ByRef num)
-Range("A304").Clear
-Range("B304").Clear
-Range("C304").Clear
-Range("D304").Clear
-Range("A304").Value = "xlPaperEnvelopePersonal"
-Range("B304").Value = 38
-Range("C304").Value = num
-B304 = Range("B304").Value
-C304 = Range("C304").Value
-If B304 = C304 Then
-Range("D304").Value = "OK"
-Else
-Range("D304").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEsheet(ByRef num)
-Range("A305").Clear
-Range("B305").Clear
-Range("C305").Clear
-Range("D305").Clear
-Range("A305").Value = "xlPaperEsheet"
-Range("B305").Value = 26
-Range("C305").Value = num
-B305 = Range("B305").Value
-C305 = Range("C305").Value
-If B305 = C305 Then
-Range("D305").Value = "OK"
-Else
-Range("D305").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperExective(ByRef num)
-Range("A306").Clear
-Range("B306").Clear
-Range("C306").Clear
-Range("D306").Clear
-Range("A306").Value = "xlPaperExective"
-Range("B306").Value = 7
-Range("C306").Value = num
-B306 = Range("B306").Value
-C306 = Range("C306").Value
-If B306 = C306 Then
-Range("D306").Value = "OK"
-Else
-Range("D306").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperFanfoldLegalGerman(ByRef num)
-Range("A307").Clear
-Range("B307").Clear
-Range("C307").Clear
-Range("D307").Clear
-Range("A307").Value = "xlPaperFanfoldLegalGerman"
-Range("B307").Value = 41
-Range("C307").Value = num
-B307 = Range("B307").Value
-C307 = Range("C307").Value
-If B307 = C307 Then
-Range("D307").Value = "OK"
-Else
-Range("D307").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperFanfoldStdGerman(ByRef num)
-Range("A308").Clear
-Range("B308").Clear
-Range("C308").Clear
-Range("D308").Clear
-Range("A308").Value = "xlPaperFanfoldStdGerman"
-Range("B308").Value = 40
-Range("C308").Value = num
-B308 = Range("B308").Value
-C308 = Range("C308").Value
-If B308 = C308 Then
-Range("D308").Value = "OK"
-Else
-Range("D308").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperFanfoldUS(ByRef num)
-Range("A309").Clear
-Range("B309").Clear
-Range("C309").Clear
-Range("D309").Clear
-Range("A309").Value = "xlPaperFanfoldUS"
-Range("B309").Value = 39
-Range("C309").Value = num
-B309 = Range("B309").Value
-C309 = Range("C309").Value
-If B309 = C309 Then
-Range("D309").Value = "OK"
-Else
-Range("D309").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperFolio(ByRef num)
-Range("A310").Clear
-Range("B310").Clear
-Range("C310").Clear
-Range("D310").Clear
-Range("A310").Value = "xlPaperFolio"
-Range("B310").Value = 14
-Range("C310").Value = num
-B310 = Range("B310").Value
-C310 = Range("C310").Value
-If B310 = C310 Then
-Range("D310").Value = "OK"
-Else
-Range("D310").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperLedger(ByRef num)
-Range("A311").Clear
-Range("B311").Clear
-Range("C311").Clear
-Range("D311").Clear
-Range("A311").Value = "xlPaperLedger"
-Range("B311").Value = 4
-Range("C311").Value = num
-B311 = Range("B311").Value
-C311 = Range("C311").Value
-If B311 = C311 Then
-Range("D311").Value = "OK"
-Else
-Range("D311").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperLegal(ByRef num)
-Range("A312").Clear
-Range("B312").Clear
-Range("C312").Clear
-Range("D312").Clear
-Range("A312").Value = "xlPaperLegal"
-Range("B312").Value = 5
-Range("C312").Value = num
-B312 = Range("B312").Value
-C312 = Range("C312").Value
-If B312 = C312 Then
-Range("D312").Value = "OK"
-Else
-Range("D312").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperLetter(ByRef num)
-Range("A313").Clear
-Range("B313").Clear
-Range("C313").Clear
-Range("D313").Clear
-Range("A313").Value = "xlPaperLetter"
-Range("B313").Value = 1
-Range("C313").Value = num
-B313 = Range("B313").Value
-C313 = Range("C313").Value
-If B313 = C313 Then
-Range("D313").Value = "OK"
-Else
-Range("D313").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperLetterSmall(ByRef num)
-Range("A314").Clear
-Range("B314").Clear
-Range("C314").Clear
-Range("D314").Clear
-Range("A314").Value = "xlPaperLetterSmall"
-Range("B314").Value = 2
-Range("C314").Value = num
-B314 = Range("B314").Value
-C314 = Range("C314").Value
-If B314 = C314 Then
-Range("D314").Value = "OK"
-Else
-Range("D314").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperNote(ByRef num)
-Range("A315").Clear
-Range("B315").Clear
-Range("C315").Clear
-Range("D315").Clear
-Range("A315").Value = "xlPaperNote"
-Range("B315").Value = 18
-Range("C315").Value = num
-B315 = Range("B315").Value
-C315 = Range("C315").Value
-If B315 = C315 Then
-Range("D315").Value = "OK"
-Else
-Range("D315").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperQuarto(ByRef num)
-Range("A316").Clear
-Range("B316").Clear
-Range("C316").Clear
-Range("D316").Clear
-Range("A316").Value = "xlPaperQuarto"
-Range("B316").Value = 15
-Range("C316").Value = num
-B316 = Range("B316").Value
-C316 = Range("C316").Value
-If B316 = C316 Then
-Range("D316").Value = "OK"
-Else
-Range("D316").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperStatement(ByRef num)
-Range("A317").Clear
-Range("B317").Clear
-Range("C317").Clear
-Range("D317").Clear
-Range("A317").Value = "xlPaperStatement"
-Range("B317").Value = 6
-Range("C317").Value = num
-B317 = Range("B317").Value
-C317 = Range("C317").Value
-If B317 = C317 Then
-Range("D317").Value = "OK"
-Else
-Range("D317").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperTabloid(ByRef num)
-Range("A318").Clear
-Range("B318").Clear
-Range("C318").Clear
-Range("D318").Clear
-Range("A318").Value = "xlPaperTabloid"
-Range("B318").Value = 3
-Range("C318").Value = num
-B318 = Range("B318").Value
-C318 = Range("C318").Value
-If B318 = C318 Then
-Range("D318").Value = "OK"
-Else
-Range("D318").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperUser(ByRef num)
-Range("A319").Clear
-Range("B319").Clear
-Range("C319").Clear
-Range("D319").Clear
-Range("A319").Value = "xlPaperUser"
-Range("B319").Value = 256
-Range("C319").Value = num
-B319 = Range("B319").Value
-C319 = Range("C319").Value
-If B319 = C319 Then
-Range("D319").Value = "OK"
-Else
-Range("D319").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeBigInt(ByRef num)
-Range("A320").Clear
-Range("B320").Clear
-Range("C320").Clear
-Range("D320").Clear
-Range("A320").Value = "xlParameterTypeBigInt"
-Range("B320").Value = -5
-Range("C320").Value = num
-B320 = Range("B320").Value
-C320 = Range("C320").Value
-If B320 = C320 Then
-Range("D320").Value = "OK"
-Else
-Range("D320").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeBinary(ByRef num)
-Range("A321").Clear
-Range("B321").Clear
-Range("C321").Clear
-Range("D321").Clear
-Range("A321").Value = "xlParameterTypeBinary"
-Range("B321").Value = -2
-Range("C321").Value = num
-B321 = Range("B321").Value
-C321 = Range("C321").Value
-If B321 = C321 Then
-Range("D321").Value = "OK"
-Else
-Range("D321").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeBit(ByRef num)
-Range("A322").Clear
-Range("B322").Clear
-Range("C322").Clear
-Range("D322").Clear
-Range("A322").Value = "xlParameterTypeBit"
-Range("B322").Value = -7
-Range("C322").Value = num
-B322 = Range("B322").Value
-C322 = Range("C322").Value
-If B322 = C322 Then
-Range("D322").Value = "OK"
-Else
-Range("D322").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeChar(ByRef num)
-Range("A323").Clear
-Range("B323").Clear
-Range("C323").Clear
-Range("D323").Clear
-Range("A323").Value = "xlParameterTypeChar"
-Range("B323").Value = 1
-Range("C323").Value = num
-B323 = Range("B323").Value
-C323 = Range("C323").Value
-If B323 = C323 Then
-Range("D323").Value = "OK"
-Else
-Range("D323").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeData(ByRef num)
-Range("A324").Clear
-Range("B324").Clear
-Range("C324").Clear
-Range("D324").Clear
-Range("A324").Value = "xlParameterTypeData"
-Range("B324").Value = 9
-Range("C324").Value = num
-B324 = Range("B324").Value
-C324 = Range("C324").Value
-If B324 = C324 Then
-Range("D324").Value = "OK"
-Else
-Range("D324").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeDecimal(ByRef num)
-Range("A325").Clear
-Range("B325").Clear
-Range("C325").Clear
-Range("D325").Clear
-Range("A325").Value = "xlParameterTypeDecimal"
-Range("B325").Value = 3
-Range("C325").Value = num
-B325 = Range("B325").Value
-C325 = Range("C325").Value
-If B325 = C325 Then
-Range("D325").Value = "OK"
-Else
-Range("D325").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeDouble(ByRef num)
-Range("A326").Clear
-Range("B326").Clear
-Range("C326").Clear
-Range("D326").Clear
-Range("A326").Value = "xlParameterTypeDouble"
-Range("B326").Value = 8
-Range("C326").Value = num
-B326 = Range("B326").Value
-C326 = Range("C326").Value
-If B326 = C326 Then
-Range("D326").Value = "OK"
-Else
-Range("D326").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeFloat(ByRef num)
-Range("A327").Clear
-Range("B327").Clear
-Range("C327").Clear
-Range("D327").Clear
-Range("A327").Value = "xlParameterTypeFloat"
-Range("B327").Value = 6
-Range("C327").Value = num
-B327 = Range("B327").Value
-C327 = Range("C327").Value
-If B327 = C327 Then
-Range("D327").Value = "OK"
-Else
-Range("D327").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeInteger(ByRef num)
-Range("A328").Clear
-Range("B328").Clear
-Range("C328").Clear
-Range("D328").Clear
-Range("A328").Value = "xlParameterTypeInteger"
-Range("B328").Value = 4
-Range("C328").Value = num
-B328 = Range("B328").Value
-C328 = Range("C328").Value
-If B328 = C328 Then
-Range("D328").Value = "OK"
-Else
-Range("D328").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeLongVarBinary(ByRef num)
-Range("A329").Clear
-Range("B329").Clear
-Range("C329").Clear
-Range("D329").Clear
-Range("A329").Value = "xlParameterTypeLongVarBinary"
-Range("B329").Value = -4
-Range("C329").Value = num
-B329 = Range("B329").Value
-C329 = Range("C329").Value
-If B329 = C329 Then
-Range("D329").Value = "OK"
-Else
-Range("D329").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeLongVarChar(ByRef num)
-Range("A330").Clear
-Range("B330").Clear
-Range("C330").Clear
-Range("D330").Clear
-Range("A330").Value = "xlParameterTypeLongVarChar"
-Range("B330").Value = -1
-Range("C330").Value = num
-B330 = Range("B330").Value
-C330 = Range("C330").Value
-If B330 = C330 Then
-Range("D330").Value = "OK"
-Else
-Range("D330").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeNumeric(ByRef num)
-Range("A331").Clear
-Range("B331").Clear
-Range("C331").Clear
-Range("D331").Clear
-Range("A331").Value = "xlParameterTypeNumeric"
-Range("B331").Value = 2
-Range("C331").Value = num
-B331 = Range("B331").Value
-C331 = Range("C331").Value
-If B331 = C331 Then
-Range("D331").Value = "OK"
-Else
-Range("D331").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeReal(ByRef num)
-Range("A332").Clear
-Range("B332").Clear
-Range("C332").Clear
-Range("D332").Clear
-Range("A332").Value = "xlParameterTypeReal"
-Range("B332").Value = 7
-Range("C332").Value = num
-B332 = Range("B332").Value
-C332 = Range("C332").Value
-If B332 = C332 Then
-Range("D332").Value = "OK"
-Else
-Range("D332").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeSmallInt(ByRef num)
-Range("A333").Clear
-Range("B333").Clear
-Range("C333").Clear
-Range("D333").Clear
-Range("A333").Value = "xlParameterTypeSmallInt"
-Range("B333").Value = 5
-Range("C333").Value = num
-B333 = Range("B333").Value
-C333 = Range("C333").Value
-If B333 = C333 Then
-Range("D333").Value = "OK"
-Else
-Range("D333").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeTime(ByRef num)
-Range("A334").Clear
-Range("B334").Clear
-Range("C334").Clear
-Range("D334").Clear
-Range("A334").Value = "xlParameterTypeTime"
-Range("B334").Value = 10
-Range("C334").Value = num
-B334 = Range("B334").Value
-C334 = Range("C334").Value
-If B334 = C334 Then
-Range("D334").Value = "OK"
-Else
-Range("D334").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeTimestamp(ByRef num)
-Range("A335").Clear
-Range("B335").Clear
-Range("C335").Clear
-Range("D335").Clear
-Range("A335").Value = "xlParameterTypeTimestamp"
-Range("B335").Value = 11
-Range("C335").Value = num
-B335 = Range("B335").Value
-C335 = Range("C335").Value
-If B335 = C335 Then
-Range("D335").Value = "OK"
-Else
-Range("D335").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeTinyInt(ByRef num)
-Range("A336").Clear
-Range("B336").Clear
-Range("C336").Clear
-Range("D336").Clear
-Range("A336").Value = "xlParameterTypeTinyInt"
-Range("B336").Value = -6
-Range("C336").Value = num
-B336 = Range("B336").Value
-C336 = Range("C336").Value
-If B336 = C336 Then
-Range("D336").Value = "OK"
-Else
-Range("D336").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeUnknown(ByRef num)
-Range("A337").Clear
-Range("B337").Clear
-Range("C337").Clear
-Range("D337").Clear
-Range("A337").Value = "xlParameterTypeUnknown"
-Range("B337").Value = 0
-Range("C337").Value = num
-B337 = Range("B337").Value
-C337 = Range("C337").Value
-If B337 = C337 Then
-Range("D337").Value = "OK"
-Else
-Range("D337").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeVarBinary(ByRef num)
-Range("A338").Clear
-Range("B338").Clear
-Range("C338").Clear
-Range("D338").Clear
-Range("A338").Value = "xlParameterTypeVarBinary"
-Range("B338").Value = -3
-Range("C338").Value = num
-B338 = Range("B338").Value
-C338 = Range("C338").Value
-If B338 = C338 Then
-Range("D338").Value = "OK"
-Else
-Range("D338").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeVarChar(ByRef num)
-Range("A339").Clear
-Range("B339").Clear
-Range("C339").Clear
-Range("D339").Clear
-Range("A339").Value = "xlParameterTypeVarChar"
-Range("B339").Value = 12
-Range("C339").Value = num
-B339 = Range("B339").Value
-C339 = Range("C339").Value
-If B339 = C339 Then
-Range("D339").Value = "OK"
-Else
-Range("D339").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeWChar(ByRef num)
-Range("A340").Clear
-Range("B340").Clear
-Range("C340").Clear
-Range("D340").Clear
-Range("A340").Value = "xlParameterTypeWChar"
-Range("B340").Value = -8
-Range("C340").Value = num
-B340 = Range("B340").Value
-C340 = Range("C340").Value
-If B340 = C340 Then
-Range("D340").Value = "OK"
-Else
-Range("D340").Value = "NG"
-End If
-End Function
-
-Function test_xlConstant(ByRef num)
-Range("A341").Clear
-Range("B341").Clear
-Range("C341").Clear
-Range("D341").Clear
-Range("A341").Value = "xlConstant"
-Range("B341").Value = 1
-Range("C341").Value = num
-B341 = Range("B341").Value
-C341 = Range("C341").Value
-If B341 = C341 Then
-Range("D341").Value = "OK"
-Else
-Range("D341").Value = "NG"
-End If
-End Function
-
-Function test_xlPrompt(ByRef num)
-Range("A342").Clear
-Range("B342").Clear
-Range("C342").Clear
-Range("D342").Clear
-Range("A342").Value = "xlPrompt"
-Range("B342").Value = 0
-Range("C342").Value = num
-B342 = Range("B342").Value
-C342 = Range("C342").Value
-If B342 = C342 Then
-Range("D342").Value = "OK"
-Else
-Range("D342").Value = "NG"
-End If
-End Function
-
-Function test_xlRange(ByRef num)
-Range("A343").Clear
-Range("B343").Clear
-Range("C343").Clear
-Range("D343").Clear
-Range("A343").Value = "xlRange"
-Range("B343").Value = 2
-Range("C343").Value = num
-B343 = Range("B343").Value
-C343 = Range("C343").Value
-If B343 = C343 Then
-Range("D343").Value = "OK"
-Else
-Range("D343").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteSpecialOperationAdd(ByRef num)
-Range("A344").Clear
-Range("B344").Clear
-Range("C344").Clear
-Range("D344").Clear
-Range("A344").Value = "xlPasteSpecialOperationAdd"
-Range("B344").Value = 2
-Range("C344").Value = num
-B344 = Range("B344").Value
-C344 = Range("C344").Value
-If B344 = C344 Then
-Range("D344").Value = "OK"
-Else
-Range("D344").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteSpecialOperationDivide(ByRef num)
-Range("A345").Clear
-Range("B345").Clear
-Range("C345").Clear
-Range("D345").Clear
-Range("A345").Value = "xlPasteSpecialOperationDivide"
-Range("B345").Value = 5
-Range("C345").Value = num
-B345 = Range("B345").Value
-C345 = Range("C345").Value
-If B345 = C345 Then
-Range("D345").Value = "OK"
-Else
-Range("D345").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteSpecialOperationMultiply(ByRef num)
-Range("A346").Clear
-Range("B346").Clear
-Range("C346").Clear
-Range("D346").Clear
-Range("A346").Value = "xlPasteSpecialOperationMultiply"
-Range("B346").Value = 4
-Range("C346").Value = num
-B346 = Range("B346").Value
-C346 = Range("C346").Value
-If B346 = C346 Then
-Range("D346").Value = "OK"
-Else
-Range("D346").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteSpecialOperationNone(ByRef num)
-Range("A347").Clear
-Range("B347").Clear
-Range("C347").Clear
-Range("D347").Clear
-Range("A347").Value = "xlPasteSpecialOperationNone"
-Range("B347").Value = -4142
-Range("C347").Value = num
-B347 = Range("B347").Value
-C347 = Range("C347").Value
-If B347 = C347 Then
-Range("D347").Value = "OK"
-Else
-Range("D347").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteSpecialOperationSubstract(ByRef num)
-Range("A348").Clear
-Range("B348").Clear
-Range("C348").Clear
-Range("D348").Clear
-Range("A348").Value = "xlPasteSpecialOperationSubstract"
-Range("B348").Value = 3
-Range("C348").Value = num
-B348 = Range("B348").Value
-C348 = Range("C348").Value
-If B348 = C348 Then
-Range("D348").Value = "OK"
-Else
-Range("D348").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteAll(ByRef num)
-Range("A349").Clear
-Range("B349").Clear
-Range("C349").Clear
-Range("D349").Clear
-Range("A349").Value = "xlPasteAll"
-Range("B349").Value = -4104
-Range("C349").Value = num
-B349 = Range("B349").Value
-C349 = Range("C349").Value
-If B349 = C349 Then
-Range("D349").Value = "OK"
-Else
-Range("D349").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteAllExceptBorders(ByRef num)
-Range("A350").Clear
-Range("B350").Clear
-Range("C350").Clear
-Range("D350").Clear
-Range("A350").Value = "xlPasteAllExceptBorders"
-Range("B350").Value = 7
-Range("C350").Value = num
-B350 = Range("B350").Value
-C350 = Range("C350").Value
-If B350 = C350 Then
-Range("D350").Value = "OK"
-Else
-Range("D350").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteAllColumnWidths(ByRef num)
-Range("A351").Clear
-Range("B351").Clear
-Range("C351").Clear
-Range("D351").Clear
-Range("A351").Value = "xlPasteAllColumnWidths"
-Range("B351").Value = 8
-Range("C351").Value = num
-B351 = Range("B351").Value
-C351 = Range("C351").Value
-If B351 = C351 Then
-Range("D351").Value = "OK"
-Else
-Range("D351").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteComments(ByRef num)
-Range("A352").Clear
-Range("B352").Clear
-Range("C352").Clear
-Range("D352").Clear
-Range("A352").Value = "xlPasteComments"
-Range("B352").Value = -4144
-Range("C352").Value = num
-B352 = Range("B352").Value
-C352 = Range("C352").Value
-If B352 = C352 Then
-Range("D352").Value = "OK"
-Else
-Range("D352").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteFormats(ByRef num)
-Range("A353").Clear
-Range("B353").Clear
-Range("C353").Clear
-Range("D353").Clear
-Range("A353").Value = "xlPasteFormats"
-Range("B353").Value = -4122
-Range("C353").Value = num
-B353 = Range("B353").Value
-C353 = Range("C353").Value
-If B353 = C353 Then
-Range("D353").Value = "OK"
-Else
-Range("D353").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteFormulas(ByRef num)
-Range("A354").Clear
-Range("B354").Clear
-Range("C354").Clear
-Range("D354").Clear
-Range("A354").Value = "xlPasteFormulas"
-Range("B354").Value = -4123
-Range("C354").Value = num
-B354 = Range("B354").Value
-C354 = Range("C354").Value
-If B354 = C354 Then
-Range("D354").Value = "OK"
-Else
-Range("D354").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteFormulasAndNumberFormats(ByRef num)
-Range("A355").Clear
-Range("B355").Clear
-Range("C355").Clear
-Range("D355").Clear
-Range("A355").Value = "xlPasteFormulasAndNumberFormats"
-Range("B355").Value = 11
-Range("C355").Value = num
-B355 = Range("B355").Value
-C355 = Range("C355").Value
-If B355 = C355 Then
-Range("D355").Value = "OK"
-Else
-Range("D355").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteValidation(ByRef num)
-Range("A356").Clear
-Range("B356").Clear
-Range("C356").Clear
-Range("D356").Clear
-Range("A356").Value = "xlPasteValidation"
-Range("B356").Value = 6
-Range("C356").Value = num
-B356 = Range("B356").Value
-C356 = Range("C356").Value
-If B356 = C356 Then
-Range("D356").Value = "OK"
-Else
-Range("D356").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteValues(ByRef num)
-Range("A357").Clear
-Range("B357").Clear
-Range("C357").Clear
-Range("D357").Clear
-Range("A357").Value = "xlPasteValues"
-Range("B357").Value = -4163
-Range("C357").Value = num
-B357 = Range("B357").Value
-C357 = Range("C357").Value
-If B357 = C357 Then
-Range("D357").Value = "OK"
-Else
-Range("D357").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteValuesAndNumberFormats(ByRef num)
-Range("A358").Clear
-Range("B358").Clear
-Range("C358").Clear
-Range("D358").Clear
-Range("A358").Value = "xlPasteValuesAndNumberFormats"
-Range("B358").Value = 12
-Range("C358").Value = num
-B358 = Range("B358").Value
-C358 = Range("C358").Value
-If B358 = C358 Then
-Range("D358").Value = "OK"
-Else
-Range("D358").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternAutomatic(ByRef num)
-Range("A359").Clear
-Range("B359").Clear
-Range("C359").Clear
-Range("D359").Clear
-Range("A359").Value = "xlPatternAutomatic"
-Range("B359").Value = -4105
-Range("C359").Value = num
-B359 = Range("B359").Value
-C359 = Range("C359").Value
-If B359 = C359 Then
-Range("D359").Value = "OK"
-Else
-Range("D359").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternChecker(ByRef num)
-Range("A360").Clear
-Range("B360").Clear
-Range("C360").Clear
-Range("D360").Clear
-Range("A360").Value = "xlPatternChecker"
-Range("B360").Value = 9
-Range("C360").Value = num
-B360 = Range("B360").Value
-C360 = Range("C360").Value
-If B360 = C360 Then
-Range("D360").Value = "OK"
-Else
-Range("D360").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternCrissCross(ByRef num)
-Range("A361").Clear
-Range("B361").Clear
-Range("C361").Clear
-Range("D361").Clear
-Range("A361").Value = "xlPatternCrissCross"
-Range("B361").Value = 16
-Range("C361").Value = num
-B361 = Range("B361").Value
-C361 = Range("C361").Value
-If B361 = C361 Then
-Range("D361").Value = "OK"
-Else
-Range("D361").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternDown(ByRef num)
-Range("A362").Clear
-Range("B362").Clear
-Range("C362").Clear
-Range("D362").Clear
-Range("A362").Value = "xlPatternDown"
-Range("B362").Value = -4121
-Range("C362").Value = num
-B362 = Range("B362").Value
-C362 = Range("C362").Value
-If B362 = C362 Then
-Range("D362").Value = "OK"
-Else
-Range("D362").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGray16(ByRef num)
-Range("A363").Clear
-Range("B363").Clear
-Range("C363").Clear
-Range("D363").Clear
-Range("A363").Value = "xlPatternGray16"
-Range("B363").Value = 17
-Range("C363").Value = num
-B363 = Range("B363").Value
-C363 = Range("C363").Value
-If B363 = C363 Then
-Range("D363").Value = "OK"
-Else
-Range("D363").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGray25(ByRef num)
-Range("A364").Clear
-Range("B364").Clear
-Range("C364").Clear
-Range("D364").Clear
-Range("A364").Value = "xlPatternGray25"
-Range("B364").Value = -4124
-Range("C364").Value = num
-B364 = Range("B364").Value
-C364 = Range("C364").Value
-If B364 = C364 Then
-Range("D364").Value = "OK"
-Else
-Range("D364").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGray50(ByRef num)
-Range("A365").Clear
-Range("B365").Clear
-Range("C365").Clear
-Range("D365").Clear
-Range("A365").Value = "xlPatternGray50"
-Range("B365").Value = -4125
-Range("C365").Value = num
-B365 = Range("B365").Value
-C365 = Range("C365").Value
-If B365 = C365 Then
-Range("D365").Value = "OK"
-Else
-Range("D365").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGray75(ByRef num)
-Range("A366").Clear
-Range("B366").Clear
-Range("C366").Clear
-Range("D366").Clear
-Range("A366").Value = "xlPatternGray75"
-Range("B366").Value = -4126
-Range("C366").Value = num
-B366 = Range("B366").Value
-C366 = Range("C366").Value
-If B366 = C366 Then
-Range("D366").Value = "OK"
-Else
-Range("D366").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGray8(ByRef num)
-Range("A367").Clear
-Range("B367").Clear
-Range("C367").Clear
-Range("D367").Clear
-Range("A367").Value = "xlPatternGray8"
-Range("B367").Value = 18
-Range("C367").Value = num
-B367 = Range("B367").Value
-C367 = Range("C367").Value
-If B367 = C367 Then
-Range("D367").Value = "OK"
-Else
-Range("D367").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGrid(ByRef num)
-Range("A368").Clear
-Range("B368").Clear
-Range("C368").Clear
-Range("D368").Clear
-Range("A368").Value = "xlPatternGrid"
-Range("B368").Value = 15
-Range("C368").Value = num
-B368 = Range("B368").Value
-C368 = Range("C368").Value
-If B368 = C368 Then
-Range("D368").Value = "OK"
-Else
-Range("D368").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternHorizontal(ByRef num)
-Range("A369").Clear
-Range("B369").Clear
-Range("C369").Clear
-Range("D369").Clear
-Range("A369").Value = "xlPatternHorizontal"
-Range("B369").Value = -4128
-Range("C369").Value = num
-B369 = Range("B369").Value
-C369 = Range("C369").Value
-If B369 = C369 Then
-Range("D369").Value = "OK"
-Else
-Range("D369").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternLightDown(ByRef num)
-Range("A370").Clear
-Range("B370").Clear
-Range("C370").Clear
-Range("D370").Clear
-Range("A370").Value = "xlPatternLightDown"
-Range("B370").Value = 13
-Range("C370").Value = num
-B370 = Range("B370").Value
-C370 = Range("C370").Value
-If B370 = C370 Then
-Range("D370").Value = "OK"
-Else
-Range("D370").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternLightHorizontal(ByRef num)
-Range("A371").Clear
-Range("B371").Clear
-Range("C371").Clear
-Range("D371").Clear
-Range("A371").Value = "xlPatternLightHorizontal"
-Range("B371").Value = 11
-Range("C371").Value = num
-B371 = Range("B371").Value
-C371 = Range("C371").Value
-If B371 = C371 Then
-Range("D371").Value = "OK"
-Else
-Range("D371").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternLightUp(ByRef num)
-Range("A372").Clear
-Range("B372").Clear
-Range("C372").Clear
-Range("D372").Clear
-Range("A372").Value = "xlPatternLightUp"
-Range("B372").Value = 14
-Range("C372").Value = num
-B372 = Range("B372").Value
-C372 = Range("C372").Value
-If B372 = C372 Then
-Range("D372").Value = "OK"
-Else
-Range("D372").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternLightVertical(ByRef num)
-Range("A373").Clear
-Range("B373").Clear
-Range("C373").Clear
-Range("D373").Clear
-Range("A373").Value = "xlPatternLightVertical"
-Range("B373").Value = 12
-Range("C373").Value = num
-B373 = Range("B373").Value
-C373 = Range("C373").Value
-If B373 = C373 Then
-Range("D373").Value = "OK"
-Else
-Range("D373").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternNone(ByRef num)
-Range("A374").Clear
-Range("B374").Clear
-Range("C374").Clear
-Range("D374").Clear
-Range("A374").Value = "xlPatternNone"
-Range("B374").Value = -4142
-Range("C374").Value = num
-B374 = Range("B374").Value
-C374 = Range("C374").Value
-If B374 = C374 Then
-Range("D374").Value = "OK"
-Else
-Range("D374").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternSemiGray75(ByRef num)
-Range("A375").Clear
-Range("B375").Clear
-Range("C375").Clear
-Range("D375").Clear
-Range("A375").Value = "xlPatternSemiGray75"
-Range("B375").Value = 10
-Range("C375").Value = num
-B375 = Range("B375").Value
-C375 = Range("C375").Value
-If B375 = C375 Then
-Range("D375").Value = "OK"
-Else
-Range("D375").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternSolid(ByRef num)
-Range("A376").Clear
-Range("B376").Clear
-Range("C376").Clear
-Range("D376").Clear
-Range("A376").Value = "xlPatternSolid"
-Range("B376").Value = 1
-Range("C376").Value = num
-B376 = Range("B376").Value
-C376 = Range("C376").Value
-If B376 = C376 Then
-Range("D376").Value = "OK"
-Else
-Range("D376").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternUp(ByRef num)
-Range("A377").Clear
-Range("B377").Clear
-Range("C377").Clear
-Range("D377").Clear
-Range("A377").Value = "xlPatternUp"
-Range("B377").Value = -4162
-Range("C377").Value = num
-B377 = Range("B377").Value
-C377 = Range("C377").Value
-If B377 = C377 Then
-Range("D377").Value = "OK"
-Else
-Range("D377").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternVertical(ByRef num)
-Range("A378").Clear
-Range("B378").Clear
-Range("C378").Clear
-Range("D378").Clear
-Range("A378").Value = "xlPatternVertical"
-Range("B378").Value = -4166
-Range("C378").Value = num
-B378 = Range("B378").Value
-C378 = Range("C378").Value
-If B378 = C378 Then
-Range("D378").Value = "OK"
-Else
-Range("D378").Value = "NG"
-End If
-End Function
-
-Function test_XlPhoneticAlignCenter(ByRef num)
-Range("A379").Clear
-Range("B379").Clear
-Range("C379").Clear
-Range("D379").Clear
-Range("A379").Value = "XlPhoneticAlignCenter"
-Range("B379").Value = 2
-Range("C379").Value = num
-B379 = Range("B379").Value
-C379 = Range("C379").Value
-If B379 = C379 Then
-Range("D379").Value = "OK"
-Else
-Range("D379").Value = "NG"
-End If
-End Function
-
-Function test_XlPhoneticAlignDistributed(ByRef num)
-Range("A380").Clear
-Range("B380").Clear
-Range("C380").Clear
-Range("D380").Clear
-Range("A380").Value = "XlPhoneticAlignDistributed"
-Range("B380").Value = 3
-Range("C380").Value = num
-B380 = Range("B380").Value
-C380 = Range("C380").Value
-If B380 = C380 Then
-Range("D380").Value = "OK"
-Else
-Range("D380").Value = "NG"
-End If
-End Function
-
-Function test_XlPhoneticAlignLeft(ByRef num)
-Range("A381").Clear
-Range("B381").Clear
-Range("C381").Clear
-Range("D381").Clear
-Range("A381").Value = "XlPhoneticAlignLeft"
-Range("B381").Value = 1
-Range("C381").Value = num
-B381 = Range("B381").Value
-C381 = Range("C381").Value
-If B381 = C381 Then
-Range("D381").Value = "OK"
-Else
-Range("D381").Value = "NG"
-End If
-End Function
-
-Function test_XlPhoneticAlignNoControl(ByRef num)
-Range("A382").Clear
-Range("B382").Clear
-Range("C382").Clear
-Range("D382").Clear
-Range("A382").Value = "XlPhoneticAlignNoControl"
-Range("B382").Value = 0
-Range("C382").Value = num
-B382 = Range("B382").Value
-C382 = Range("C382").Value
-If B382 = C382 Then
-Range("D382").Value = "OK"
-Else
-Range("D382").Value = "NG"
-End If
-End Function
-
-Function test_xlPrinter(ByRef num)
-Range("A383").Clear
-Range("B383").Clear
-Range("C383").Clear
-Range("D383").Clear
-Range("A383").Value = "xlPrinter"
-Range("B383").Value = 2
-Range("C383").Value = num
-B383 = Range("B383").Value
-C383 = Range("C383").Value
-If B383 = C383 Then
-Range("D383").Value = "OK"
-Else
-Range("D383").Value = "NG"
-End If
-End Function
-
-Function test_xlScreen(ByRef num)
-Range("A384").Clear
-Range("B384").Clear
-Range("C384").Clear
-Range("D384").Clear
-Range("A384").Value = "xlScreen"
-Range("B384").Value = 1
-Range("C384").Value = num
-B384 = Range("B384").Value
-C384 = Range("C384").Value
-If B384 = C384 Then
-Range("D384").Value = "OK"
-Else
-Range("D384").Value = "NG"
-End If
-End Function
-
-Function test_xlBMP(ByRef num)
-Range("A385").Clear
-Range("B385").Clear
-Range("C385").Clear
-Range("D385").Clear
-Range("A385").Value = "xlBMP"
-Range("B385").Value = 1
-Range("C385").Value = num
-B385 = Range("B385").Value
-C385 = Range("C385").Value
-If B385 = C385 Then
-Range("D385").Value = "OK"
-Else
-Range("D385").Value = "NG"
-End If
-End Function
-
-Function test_xlCGM(ByRef num)
-Range("A386").Clear
-Range("B386").Clear
-Range("C386").Clear
-Range("D386").Clear
-Range("A386").Value = "xlCGM"
-Range("B386").Value = 7
-Range("C386").Value = num
-B386 = Range("B386").Value
-C386 = Range("C386").Value
-If B386 = C386 Then
-Range("D386").Value = "OK"
-Else
-Range("D386").Value = "NG"
-End If
-End Function
-
-Function test_xlDRW(ByRef num)
-Range("A387").Clear
-Range("B387").Clear
-Range("C387").Clear
-Range("D387").Clear
-Range("A387").Value = "xlDRW"
-Range("B387").Value = 4
-Range("C387").Value = num
-B387 = Range("B387").Value
-C387 = Range("C387").Value
-If B387 = C387 Then
-Range("D387").Value = "OK"
-Else
-Range("D387").Value = "NG"
-End If
-End Function
-
-Function test_xlDXF(ByRef num)
-Range("A388").Clear
-Range("B388").Clear
-Range("C388").Clear
-Range("D388").Clear
-Range("A388").Value = "xlDXF"
-Range("B388").Value = 5
-Range("C388").Value = num
-B388 = Range("B388").Value
-C388 = Range("C388").Value
-If B388 = C388 Then
-Range("D388").Value = "OK"
-Else
-Range("D388").Value = "NG"
-End If
-End Function
-
-Function test_xlEPS(ByRef num)
-Range("A389").Clear
-Range("B389").Clear
-Range("C389").Clear
-Range("D389").Clear
-Range("A389").Value = "xlEPS"
-Range("B389").Value = 8
-Range("C389").Value = num
-B389 = Range("B389").Value
-C389 = Range("C389").Value
-If B389 = C389 Then
-Range("D389").Value = "OK"
-Else
-Range("D389").Value = "NG"
-End If
-End Function
-
-Function test_xlHGL(ByRef num)
-Range("A390").Clear
-Range("B390").Clear
-Range("C390").Clear
-Range("D390").Clear
-Range("A390").Value = "xlHGL"
-Range("B390").Value = 6
-Range("C390").Value = num
-B390 = Range("B390").Value
-C390 = Range("C390").Value
-If B390 = C390 Then
-Range("D390").Value = "OK"
-Else
-Range("D390").Value = "NG"
-End If
-End Function
-
-Function test_xlPCT(ByRef num)
-Range("A391").Clear
-Range("B391").Clear
-Range("C391").Clear
-Range("D391").Clear
-Range("A391").Value = "xlPCT"
-Range("B391").Value = 13
-Range("C391").Value = num
-B391 = Range("B391").Value
-C391 = Range("C391").Value
-If B391 = C391 Then
-Range("D391").Value = "OK"
-Else
-Range("D391").Value = "NG"
-End If
-End Function
-
-Function test_xlPCX(ByRef num)
-Range("A392").Clear
-Range("B392").Clear
-Range("C392").Clear
-Range("D392").Clear
-Range("A392").Value = "xlPCX"
-Range("B392").Value = 10
-Range("C392").Value = num
-B392 = Range("B392").Value
-C392 = Range("C392").Value
-If B392 = C392 Then
-Range("D392").Value = "OK"
-Else
-Range("D392").Value = "NG"
-End If
-End Function
-
-Function test_xlPIC(ByRef num)
-Range("A393").Clear
-Range("B393").Clear
-Range("C393").Clear
-Range("D393").Clear
-Range("A393").Value = "xlPIC"
-Range("B393").Value = 11
-Range("C393").Value = num
-B393 = Range("B393").Value
-C393 = Range("C393").Value
-If B393 = C393 Then
-Range("D393").Value = "OK"
-Else
-Range("D393").Value = "NG"
-End If
-End Function
-
-Function test_xlPLT(ByRef num)
-Range("A394").Clear
-Range("B394").Clear
-Range("C394").Clear
-Range("D394").Clear
-Range("A394").Value = "xlPLT"
-Range("B394").Value = 12
-Range("C394").Value = num
-B394 = Range("B394").Value
-C394 = Range("C394").Value
-If B394 = C394 Then
-Range("D394").Value = "OK"
-Else
-Range("D394").Value = "NG"
-End If
-End Function
-
-Function test_xlTIF(ByRef num)
-Range("A395").Clear
-Range("B395").Clear
-Range("C395").Clear
-Range("D395").Clear
-Range("A395").Value = "xlTIF"
-Range("B395").Value = 9
-Range("C395").Value = num
-B395 = Range("B395").Value
-C395 = Range("C395").Value
-If B395 = C395 Then
-Range("D395").Value = "OK"
-Else
-Range("D395").Value = "NG"
-End If
-End Function
-
-Function test_xlWMF(ByRef num)
-Range("A396").Clear
-Range("B396").Clear
-Range("C396").Clear
-Range("D396").Clear
-Range("A396").Value = "xlWMF"
-Range("B396").Value = 2
-Range("C396").Value = num
-B396 = Range("B396").Value
-C396 = Range("C396").Value
-If B396 = C396 Then
-Range("D396").Value = "OK"
-Else
-Range("D396").Value = "NG"
-End If
-End Function
-
-Function test_xlWPG(ByRef num)
-Range("A397").Clear
-Range("B397").Clear
-Range("C397").Clear
-Range("D397").Clear
-Range("A397").Value = "xlWPG"
-Range("B397").Value = 3
-Range("C397").Value = num
-B397 = Range("B397").Value
-C397 = Range("C397").Value
-If B397 = C397 Then
-Range("D397").Value = "OK"
-Else
-Range("D397").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellBlankCell(ByRef num)
-Range("A398").Clear
-Range("B398").Clear
-Range("C398").Clear
-Range("D398").Clear
-Range("A398").Value = "xlPivotCellBlankCell"
-Range("B398").Value = 0
-Range("C398").Value = num
-B398 = Range("B398").Value
-C398 = Range("C398").Value
-If B398 = C398 Then
-Range("D398").Value = "OK"
-Else
-Range("D398").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellCustomSubtotal(ByRef num)
-Range("A399").Clear
-Range("B399").Clear
-Range("C399").Clear
-Range("D399").Clear
-Range("A399").Value = "xlPivotCellCustomSubtotal"
-Range("B399").Value = 7
-Range("C399").Value = num
-B399 = Range("B399").Value
-C399 = Range("C399").Value
-If B399 = C399 Then
-Range("D399").Value = "OK"
-Else
-Range("D399").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellDataField(ByRef num)
-Range("A400").Clear
-Range("B400").Clear
-Range("C400").Clear
-Range("D400").Clear
-Range("A400").Value = "xlPivotCellDataField"
-Range("B400").Value = 4
-Range("C400").Value = num
-B400 = Range("B400").Value
-C400 = Range("C400").Value
-If B400 = C400 Then
-Range("D400").Value = "OK"
-Else
-Range("D400").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellDataPivotField(ByRef num)
-Range("A401").Clear
-Range("B401").Clear
-Range("C401").Clear
-Range("D401").Clear
-Range("A401").Value = "xlPivotCellDataPivotField"
-Range("B401").Value = 8
-Range("C401").Value = num
-B401 = Range("B401").Value
-C401 = Range("C401").Value
-If B401 = C401 Then
-Range("D401").Value = "OK"
-Else
-Range("D401").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellGrandTotal(ByRef num)
-Range("A402").Clear
-Range("B402").Clear
-Range("C402").Clear
-Range("D402").Clear
-Range("A402").Value = "xlPivotCellGrandTotal"
-Range("B402").Value = 3
-Range("C402").Value = num
-B402 = Range("B402").Value
-C402 = Range("C402").Value
-If B402 = C402 Then
-Range("D402").Value = "OK"
-Else
-Range("D402").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellPageFieldItem(ByRef num)
-Range("A403").Clear
-Range("B403").Clear
-Range("C403").Clear
-Range("D403").Clear
-Range("A403").Value = "xlPivotCellPageFieldItem"
-Range("B403").Value = 6
-Range("C403").Value = num
-B403 = Range("B403").Value
-C403 = Range("C403").Value
-If B403 = C403 Then
-Range("D403").Value = "OK"
-Else
-Range("D403").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellPivotField(ByRef num)
-Range("A404").Clear
-Range("B404").Clear
-Range("C404").Clear
-Range("D404").Clear
-Range("A404").Value = "xlPivotCellPivotField"
-Range("B404").Value = 5
-Range("C404").Value = num
-B404 = Range("B404").Value
-C404 = Range("C404").Value
-If B404 = C404 Then
-Range("D404").Value = "OK"
-Else
-Range("D404").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellPivotItem(ByRef num)
-Range("A405").Clear
-Range("B405").Clear
-Range("C405").Clear
-Range("D405").Clear
-Range("A405").Value = "xlPivotCellPivotItem"
-Range("B405").Value = 1
-Range("C405").Value = num
-B405 = Range("B405").Value
-C405 = Range("C405").Value
-If B405 = C405 Then
-Range("D405").Value = "OK"
-Else
-Range("D405").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellSubtotal(ByRef num)
-Range("A406").Clear
-Range("B406").Clear
-Range("C406").Clear
-Range("D406").Clear
-Range("A406").Value = "xlPivotCellSubtotal"
-Range("B406").Value = 2
-Range("C406").Value = num
-B406 = Range("B406").Value
-C406 = Range("C406").Value
-If B406 = C406 Then
-Range("D406").Value = "OK"
-Else
-Range("D406").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellValue(ByRef num)
-Range("A407").Clear
-Range("B407").Clear
-Range("C407").Clear
-Range("D407").Clear
-Range("A407").Value = "xlPivotCellValue"
-Range("B407").Value = 0
-Range("C407").Value = num
-B407 = Range("B407").Value
-C407 = Range("C407").Value
-If B407 = C407 Then
-Range("D407").Value = "OK"
-Else
-Range("D407").Value = "NG"
-End If
-End Function
-
-Function test_xlDifferenceFrom(ByRef num)
-Range("A408").Clear
-Range("B408").Clear
-Range("C408").Clear
-Range("D408").Clear
-Range("A408").Value = "xlDifferenceFrom"
-Range("B408").Value = 2
-Range("C408").Value = num
-B408 = Range("B408").Value
-C408 = Range("C408").Value
-If B408 = C408 Then
-Range("D408").Value = "OK"
-Else
-Range("D408").Value = "NG"
-End If
-End Function
-
-Function test_xlIndex(ByRef num)
-Range("A409").Clear
-Range("B409").Clear
-Range("C409").Clear
-Range("D409").Clear
-Range("A409").Value = "xlIndex"
-Range("B409").Value = 9
-Range("C409").Value = num
-B409 = Range("B409").Value
-C409 = Range("C409").Value
-If B409 = C409 Then
-Range("D409").Value = "OK"
-Else
-Range("D409").Value = "NG"
-End If
-End Function
-
-Function test_xlNoAdditionalCalculation(ByRef num)
-Range("A410").Clear
-Range("B410").Clear
-Range("C410").Clear
-Range("D410").Clear
-Range("A410").Value = "xlNoAdditionalCalculation"
-Range("B410").Value = -4143
-Range("C410").Value = num
-B410 = Range("B410").Value
-C410 = Range("C410").Value
-If B410 = C410 Then
-Range("D410").Value = "OK"
-Else
-Range("D410").Value = "NG"
-End If
-End Function
-
-Function test_xlPercentDifferenceFrom(ByRef num)
-Range("A411").Clear
-Range("B411").Clear
-Range("C411").Clear
-Range("D411").Clear
-Range("A411").Value = "xlPercentDifferenceFrom"
-Range("B411").Value = 4
-Range("C411").Value = num
-B411 = Range("B411").Value
-C411 = Range("C411").Value
-If B411 = C411 Then
-Range("D411").Value = "OK"
-Else
-Range("D411").Value = "NG"
-End If
-End Function
-
-Function test_xlPercentOf(ByRef num)
-Range("A412").Clear
-Range("B412").Clear
-Range("C412").Clear
-Range("D412").Clear
-Range("A412").Value = "xlPercentOf"
-Range("B412").Value = 3
-Range("C412").Value = num
-B412 = Range("B412").Value
-C412 = Range("C412").Value
-If B412 = C412 Then
-Range("D412").Value = "OK"
-Else
-Range("D412").Value = "NG"
-End If
-End Function
-
-Function test_xlPercentOfColumn(ByRef num)
-Range("A413").Clear
-Range("B413").Clear
-Range("C413").Clear
-Range("D413").Clear
-Range("A413").Value = "xlPercentOfColumn"
-Range("B413").Value = 7
-Range("C413").Value = num
-B413 = Range("B413").Value
-C413 = Range("C413").Value
-If B413 = C413 Then
-Range("D413").Value = "OK"
-Else
-Range("D413").Value = "NG"
-End If
-End Function
-
-Function test_xlPercentOfRow(ByRef num)
-Range("A414").Clear
-Range("B414").Clear
-Range("C414").Clear
-Range("D414").Clear
-Range("A414").Value = "xlPercentOfRow"
-Range("B414").Value = 6
-Range("C414").Value = num
-B414 = Range("B414").Value
-C414 = Range("C414").Value
-If B414 = C414 Then
-Range("D414").Value = "OK"
-Else
-Range("D414").Value = "NG"
-End If
-End Function
-
-Function test_xlPercentOfTotal(ByRef num)
-Range("A415").Clear
-Range("B415").Clear
-Range("C415").Clear
-Range("D415").Clear
-Range("A415").Value = "xlPercentOfTotal"
-Range("B415").Value = 8
-Range("C415").Value = num
-B415 = Range("B415").Value
-C415 = Range("C415").Value
-If B415 = C415 Then
-Range("D415").Value = "OK"
-Else
-Range("D415").Value = "NG"
-End If
-End Function
-
-Function test_xlRunningTotal(ByRef num)
-Range("A416").Clear
-Range("B416").Clear
-Range("C416").Clear
-Range("D416").Clear
-Range("A416").Value = "xlRunningTotal"
-Range("B416").Value = 5
-Range("C416").Value = num
-B416 = Range("B416").Value
-C416 = Range("C416").Value
-If B416 = C416 Then
-Range("D416").Value = "OK"
-Else
-Range("D416").Value = "NG"
-End If
-End Function
-
-Function test_xlDate(ByRef num)
-Range("A417").Clear
-Range("B417").Clear
-Range("C417").Clear
-Range("D417").Clear
-Range("A417").Value = "xlDate"
-Range("B417").Value = 2
-Range("C417").Value = num
-B417 = Range("B417").Value
-C417 = Range("C417").Value
-If B417 = C417 Then
-Range("D417").Value = "OK"
-Else
-Range("D417").Value = "NG"
-End If
-End Function
-
-Function test_xlNumber(ByRef num)
-Range("A418").Clear
-Range("B418").Clear
-Range("C418").Clear
-Range("D418").Clear
-Range("A418").Value = "xlNumber"
-Range("B418").Value = -4145
-Range("C418").Value = num
-B418 = Range("B418").Value
-C418 = Range("C418").Value
-If B418 = C418 Then
-Range("D418").Value = "OK"
-Else
-Range("D418").Value = "NG"
-End If
-End Function
-
-Function test_xlText(ByRef num)
-Range("A419").Clear
-Range("B419").Clear
-Range("C419").Clear
-Range("D419").Clear
-Range("A419").Value = "xlText"
-Range("B419").Value = -4158
-Range("C419").Value = num
-B419 = Range("B419").Value
-C419 = Range("C419").Value
-If B419 = C419 Then
-Range("D419").Value = "OK"
-Else
-Range("D419").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnField(ByRef num)
-Range("A420").Clear
-Range("B420").Clear
-Range("C420").Clear
-Range("D420").Clear
-Range("A420").Value = "xlColumnField"
-Range("B420").Value = 2
-Range("C420").Value = num
-B420 = Range("B420").Value
-C420 = Range("C420").Value
-If B420 = C420 Then
-Range("D420").Value = "OK"
-Else
-Range("D420").Value = "NG"
-End If
-End Function
-
-Function test_xlDataField(ByRef num)
-Range("A421").Clear
-Range("B421").Clear
-Range("C421").Clear
-Range("D421").Clear
-Range("A421").Value = "xlDataField"
-Range("B421").Value = 4
-Range("C421").Value = num
-B421 = Range("B421").Value
-C421 = Range("C421").Value
-If B421 = C421 Then
-Range("D421").Value = "OK"
-Else
-Range("D421").Value = "NG"
-End If
-End Function
-
-Function test_xlHidden(ByRef num)
-Range("A422").Clear
-Range("B422").Clear
-Range("C422").Clear
-Range("D422").Clear
-Range("A422").Value = "xlHidden"
-Range("B422").Value = 0
-Range("C422").Value = num
-B422 = Range("B422").Value
-C422 = Range("C422").Value
-If B422 = C422 Then
-Range("D422").Value = "OK"
-Else
-Range("D422").Value = "NG"
-End If
-End Function
-
-Function test_xlPageField(ByRef num)
-Range("A423").Clear
-Range("B423").Clear
-Range("C423").Clear
-Range("D423").Clear
-Range("A423").Value = "xlPageField"
-Range("B423").Value = 3
-Range("C423").Value = num
-B423 = Range("B423").Value
-C423 = Range("C423").Value
-If B423 = C423 Then
-Range("D423").Value = "OK"
-Else
-Range("D423").Value = "NG"
-End If
-End Function
-
-Function test_xlRowField(ByRef num)
-Range("A424").Clear
-Range("B424").Clear
-Range("C424").Clear
-Range("D424").Clear
-Range("A424").Value = "xlRowField"
-Range("B424").Value = 1
-Range("C424").Value = num
-B424 = Range("B424").Value
-C424 = Range("C424").Value
-If B424 = C424 Then
-Range("D424").Value = "OK"
-Else
-Range("D424").Value = "NG"
-End If
-End Function
-
-Function test_xlPTClassic(ByRef num)
-Range("A425").Clear
-Range("B425").Clear
-Range("C425").Clear
-Range("D425").Clear
-Range("A425").Value = "xlPTClassic"
-Range("B425").Value = 20
-Range("C425").Value = num
-B425 = Range("B425").Value
-C425 = Range("C425").Value
-If B425 = C425 Then
-Range("D425").Value = "OK"
-Else
-Range("D425").Value = "NG"
-End If
-End Function
-
-Function test_xlPTNone(ByRef num)
-Range("A426").Clear
-Range("B426").Clear
-Range("C426").Clear
-Range("D426").Clear
-Range("A426").Value = "xlPTNone"
-Range("B426").Value = 21
-Range("C426").Value = num
-B426 = Range("B426").Value
-C426 = Range("C426").Value
-If B426 = C426 Then
-Range("D426").Value = "OK"
-Else
-Range("D426").Value = "NG"
-End If
-End Function
-
-Function test_xlReport1(ByRef num)
-Range("A427").Clear
-Range("B427").Clear
-Range("C427").Clear
-Range("D427").Clear
-Range("A427").Value = "xlReport1"
-Range("B427").Value = 0
-Range("C427").Value = num
-B427 = Range("B427").Value
-C427 = Range("C427").Value
-If B427 = C427 Then
-Range("D427").Value = "OK"
-Else
-Range("D427").Value = "NG"
-End If
-End Function
-
-Function test_xlReport10(ByRef num)
-Range("A428").Clear
-Range("B428").Clear
-Range("C428").Clear
-Range("D428").Clear
-Range("A428").Value = "xlReport10"
-Range("B428").Value = 9
-Range("C428").Value = num
-B428 = Range("B428").Value
-C428 = Range("C428").Value
-If B428 = C428 Then
-Range("D428").Value = "OK"
-Else
-Range("D428").Value = "NG"
-End If
-End Function
-
-Function test_xlReport2(ByRef num)
-Range("A429").Clear
-Range("B429").Clear
-Range("C429").Clear
-Range("D429").Clear
-Range("A429").Value = "xlReport2"
-Range("B429").Value = 1
-Range("C429").Value = num
-B429 = Range("B429").Value
-C429 = Range("C429").Value
-If B429 = C429 Then
-Range("D429").Value = "OK"
-Else
-Range("D429").Value = "NG"
-End If
-End Function
-
-Function test_xlReport3(ByRef num)
-Range("A430").Clear
-Range("B430").Clear
-Range("C430").Clear
-Range("D430").Clear
-Range("A430").Value = "xlReport3"
-Range("B430").Value = 2
-Range("C430").Value = num
-B430 = Range("B430").Value
-C430 = Range("C430").Value
-If B430 = C430 Then
-Range("D430").Value = "OK"
-Else
-Range("D430").Value = "NG"
-End If
-End Function
-
-Function test_xlReport4(ByRef num)
-Range("A431").Clear
-Range("B431").Clear
-Range("C431").Clear
-Range("D431").Clear
-Range("A431").Value = "xlReport4"
-Range("B431").Value = 3
-Range("C431").Value = num
-B431 = Range("B431").Value
-C431 = Range("C431").Value
-If B431 = C431 Then
-Range("D431").Value = "OK"
-Else
-Range("D431").Value = "NG"
-End If
-End Function
-
-Function test_xlReport5(ByRef num)
-Range("A432").Clear
-Range("B432").Clear
-Range("C432").Clear
-Range("D432").Clear
-Range("A432").Value = "xlReport5"
-Range("B432").Value = 4
-Range("C432").Value = num
-B432 = Range("B432").Value
-C432 = Range("C432").Value
-If B432 = C432 Then
-Range("D432").Value = "OK"
-Else
-Range("D432").Value = "NG"
-End If
-End Function
-
-Function test_xlReport6(ByRef num)
-Range("A433").Clear
-Range("B433").Clear
-Range("C433").Clear
-Range("D433").Clear
-Range("A433").Value = "xlReport6"
-Range("B433").Value = 5
-Range("C433").Value = num
-B433 = Range("B433").Value
-C433 = Range("C433").Value
-If B433 = C433 Then
-Range("D433").Value = "OK"
-Else
-Range("D433").Value = "NG"
-End If
-End Function
-
-Function test_xlReport7(ByRef num)
-Range("A434").Clear
-Range("B434").Clear
-Range("C434").Clear
-Range("D434").Clear
-Range("A434").Value = "xlReport7"
-Range("B434").Value = 6
-Range("C434").Value = num
-B434 = Range("B434").Value
-C434 = Range("C434").Value
-If B434 = C434 Then
-Range("D434").Value = "OK"
-Else
-Range("D434").Value = "NG"
-End If
-End Function
-
-Function test_xlReport8(ByRef num)
-Range("A435").Clear
-Range("B435").Clear
-Range("C435").Clear
-Range("D435").Clear
-Range("A435").Value = "xlReport8"
-Range("B435").Value = 7
-Range("C435").Value = num
-B435 = Range("B435").Value
-C435 = Range("C435").Value
-If B435 = C435 Then
-Range("D435").Value = "OK"
-Else
-Range("D435").Value = "NG"
-End If
-End Function
-
-Function test_xlReport9(ByRef num)
-Range("A436").Clear
-Range("B436").Clear
-Range("C436").Clear
-Range("D436").Clear
-Range("A436").Value = "xlReport9"
-Range("B436").Value = 8
-Range("C436").Value = num
-B436 = Range("B436").Value
-C436 = Range("C436").Value
-If B436 = C436 Then
-Range("D436").Value = "OK"
-Else
-Range("D436").Value = "NG"
-End If
-End Function
-
-Function test_xlTable1(ByRef num)
-Range("A437").Clear
-Range("B437").Clear
-Range("C437").Clear
-Range("D437").Clear
-Range("A437").Value = "xlTable1"
-Range("B437").Value = 10
-Range("C437").Value = num
-B437 = Range("B437").Value
-C437 = Range("C437").Value
-If B437 = C437 Then
-Range("D437").Value = "OK"
-Else
-Range("D437").Value = "NG"
-End If
-End Function
-
-Function test_xlTable10(ByRef num)
-Range("A438").Clear
-Range("B438").Clear
-Range("C438").Clear
-Range("D438").Clear
-Range("A438").Value = "xlTable10"
-Range("B438").Value = 19
-Range("C438").Value = num
-B438 = Range("B438").Value
-C438 = Range("C438").Value
-If B438 = C438 Then
-Range("D438").Value = "OK"
-Else
-Range("D438").Value = "NG"
-End If
-End Function
-
-Function test_xlTable2(ByRef num)
-Range("A439").Clear
-Range("B439").Clear
-Range("C439").Clear
-Range("D439").Clear
-Range("A439").Value = "xlTable2"
-Range("B439").Value = 11
-Range("C439").Value = num
-B439 = Range("B439").Value
-C439 = Range("C439").Value
-If B439 = C439 Then
-Range("D439").Value = "OK"
-Else
-Range("D439").Value = "NG"
-End If
-End Function
-
-Function test_xlTable3(ByRef num)
-Range("A440").Clear
-Range("B440").Clear
-Range("C440").Clear
-Range("D440").Clear
-Range("A440").Value = "xlTable3"
-Range("B440").Value = 12
-Range("C440").Value = num
-B440 = Range("B440").Value
-C440 = Range("C440").Value
-If B440 = C440 Then
-Range("D440").Value = "OK"
-Else
-Range("D440").Value = "NG"
-End If
-End Function
-
-Function test_xlTable4(ByRef num)
-Range("A441").Clear
-Range("B441").Clear
-Range("C441").Clear
-Range("D441").Clear
-Range("A441").Value = "xlTable4"
-Range("B441").Value = 13
-Range("C441").Value = num
-B441 = Range("B441").Value
-C441 = Range("C441").Value
-If B441 = C441 Then
-Range("D441").Value = "OK"
-Else
-Range("D441").Value = "NG"
-End If
-End Function
-
-Function test_xlTable5(ByRef num)
-Range("A442").Clear
-Range("B442").Clear
-Range("C442").Clear
-Range("D442").Clear
-Range("A442").Value = "xlTable5"
-Range("B442").Value = 14
-Range("C442").Value = num
-B442 = Range("B442").Value
-C442 = Range("C442").Value
-If B442 = C442 Then
-Range("D442").Value = "OK"
-Else
-Range("D442").Value = "NG"
-End If
-End Function
-
-Function test_xlTable6(ByRef num)
-Range("A443").Clear
-Range("B443").Clear
-Range("C443").Clear
-Range("D443").Clear
-Range("A443").Value = "xlTable6"
-Range("B443").Value = 15
-Range("C443").Value = num
-B443 = Range("B443").Value
-C443 = Range("C443").Value
-If B443 = C443 Then
-Range("D443").Value = "OK"
-Else
-Range("D443").Value = "NG"
-End If
-End Function
-
-Function test_xlTable7(ByRef num)
-Range("A444").Clear
-Range("B444").Clear
-Range("C444").Clear
-Range("D444").Clear
-Range("A444").Value = "xlTable7"
-Range("B444").Value = 16
-Range("C444").Value = num
-B444 = Range("B444").Value
-C444 = Range("C444").Value
-If B444 = C444 Then
-Range("D444").Value = "OK"
-Else
-Range("D444").Value = "NG"
-End If
-End Function
-
-Function test_xlTable8(ByRef num)
-Range("A445").Clear
-Range("B445").Clear
-Range("C445").Clear
-Range("D445").Clear
-Range("A445").Value = "xlTable8"
-Range("B445").Value = 17
-Range("C445").Value = num
-B445 = Range("B445").Value
-C445 = Range("C445").Value
-If B445 = C445 Then
-Range("D445").Value = "OK"
-Else
-Range("D445").Value = "NG"
-End If
-End Function
-
-Function test_xlTable9(ByRef num)
-Range("A446").Clear
-Range("B446").Clear
-Range("C446").Clear
-Range("D446").Clear
-Range("A446").Value = "xlTable9"
-Range("B446").Value = 18
-Range("C446").Value = num
-B446 = Range("B446").Value
-C446 = Range("C446").Value
-If B446 = C446 Then
-Range("D446").Value = "OK"
-Else
-Range("D446").Value = "NG"
-End If
-End Function
-
-Function test_xlMissingItemsDefault(ByRef num)
-Range("A447").Clear
-Range("B447").Clear
-Range("C447").Clear
-Range("D447").Clear
-Range("A447").Value = "xlMissingItemsDefault"
-Range("B447").Value = -1
-Range("C447").Value = num
-B447 = Range("B447").Value
-C447 = Range("C447").Value
-If B447 = C447 Then
-Range("D447").Value = "OK"
-Else
-Range("D447").Value = "NG"
-End If
-End Function
-
-Function test_xlMissingItemsMax(ByRef num)
-Range("A448").Clear
-Range("B448").Clear
-Range("C448").Clear
-Range("D448").Clear
-Range("A448").Value = "xlMissingItemsMax"
-Range("B448").Value = 32500
-Range("C448").Value = num
-B448 = Range("B448").Value
-C448 = Range("C448").Value
-If B448 = C448 Then
-Range("D448").Value = "OK"
-Else
-Range("D448").Value = "NG"
-End If
-End Function
-
-Function test_xlMissingItemsNone(ByRef num)
-Range("A449").Clear
-Range("B449").Clear
-Range("C449").Clear
-Range("D449").Clear
-Range("A449").Value = "xlMissingItemsNone"
-Range("B449").Value = 0
-Range("C449").Value = num
-B449 = Range("B449").Value
-C449 = Range("C449").Value
-If B449 = C449 Then
-Range("D449").Value = "OK"
-Else
-Range("D449").Value = "NG"
-End If
-End Function
-
-Function test_xlConsolidation(ByRef num)
-Range("A450").Clear
-Range("B450").Clear
-Range("C450").Clear
-Range("D450").Clear
-Range("A450").Value = "xlConsolidation"
-Range("B450").Value = 3
-Range("C450").Value = num
-B450 = Range("B450").Value
-C450 = Range("C450").Value
-If B450 = C450 Then
-Range("D450").Value = "OK"
-Else
-Range("D450").Value = "NG"
-End If
-End Function
-
-Function test_xlDatabase(ByRef num)
-Range("A451").Clear
-Range("B451").Clear
-Range("C451").Clear
-Range("D451").Clear
-Range("A451").Value = "xlDatabase"
-Range("B451").Value = 1
-Range("C451").Value = num
-B451 = Range("B451").Value
-C451 = Range("C451").Value
-If B451 = C451 Then
-Range("D451").Value = "OK"
-Else
-Range("D451").Value = "NG"
-End If
-End Function
-
-Function test_xlExternal(ByRef num)
-Range("A452").Clear
-Range("B452").Clear
-Range("C452").Clear
-Range("D452").Clear
-Range("A452").Value = "xlExternal"
-Range("B452").Value = 2
-Range("C452").Value = num
-B452 = Range("B452").Value
-C452 = Range("C452").Value
-If B452 = C452 Then
-Range("D452").Value = "OK"
-Else
-Range("D452").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotTable(ByRef num)
-Range("A453").Clear
-Range("B453").Clear
-Range("C453").Clear
-Range("D453").Clear
-Range("A453").Value = "xlPivotTable"
-Range("B453").Value = -4148
-Range("C453").Value = num
-B453 = Range("B453").Value
-C453 = Range("C453").Value
-If B453 = C453 Then
-Range("D453").Value = "OK"
-Else
-Range("D453").Value = "NG"
-End If
-End Function
-
-Function test_xlScenario(ByRef num)
-Range("A454").Clear
-Range("B454").Clear
-Range("C454").Clear
-Range("D454").Clear
-Range("A454").Value = "xlScenario"
-Range("B454").Value = 4
-Range("C454").Value = num
-B454 = Range("B454").Value
-C454 = Range("C454").Value
-If B454 = C454 Then
-Range("D454").Value = "OK"
-Else
-Range("D454").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotTableVersion10(ByRef num)
-Range("A455").Clear
-Range("B455").Clear
-Range("C455").Clear
-Range("D455").Clear
-Range("A455").Value = "xlPivotTableVersion10"
-Range("B455").Value = 1
-Range("C455").Value = num
-B455 = Range("B455").Value
-C455 = Range("C455").Value
-If B455 = C455 Then
-Range("D455").Value = "OK"
-Else
-Range("D455").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotTableVersion2000(ByRef num)
-Range("A456").Clear
-Range("B456").Clear
-Range("C456").Clear
-Range("D456").Clear
-Range("A456").Value = "xlPivotTableVersion2000"
-Range("B456").Value = 0
-Range("C456").Value = num
-B456 = Range("B456").Value
-C456 = Range("C456").Value
-If B456 = C456 Then
-Range("D456").Value = "OK"
-Else
-Range("D456").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotTableCurrent(ByRef num)
-Range("A457").Clear
-Range("B457").Clear
-Range("C457").Clear
-Range("D457").Clear
-Range("A457").Value = "xlPivotTableCurrent"
-Range("B457").Value = -1
-Range("C457").Value = num
-B457 = Range("B457").Value
-C457 = Range("C457").Value
-If B457 = C457 Then
-Range("D457").Value = "OK"
-Else
-Range("D457").Value = "NG"
-End If
-End Function
-
-Function test_xlFreeFloating(ByRef num)
-Range("A458").Clear
-Range("B458").Clear
-Range("C458").Clear
-Range("D458").Clear
-Range("A458").Value = "xlFreeFloating"
-Range("B458").Value = 3
-Range("C458").Value = num
-B458 = Range("B458").Value
-C458 = Range("C458").Value
-If B458 = C458 Then
-Range("D458").Value = "OK"
-Else
-Range("D458").Value = "NG"
-End If
-End Function
-
-Function test_xlMove(ByRef num)
-Range("A459").Clear
-Range("B459").Clear
-Range("C459").Clear
-Range("D459").Clear
-Range("A459").Value = "xlMove"
-Range("B459").Value = 2
-Range("C459").Value = num
-B459 = Range("B459").Value
-C459 = Range("C459").Value
-If B459 = C459 Then
-Range("D459").Value = "OK"
-Else
-Range("D459").Value = "NG"
-End If
-End Function
-
-Function test_xlMoveAndSize(ByRef num)
-Range("A460").Clear
-Range("B460").Clear
-Range("C460").Clear
-Range("D460").Clear
-Range("A460").Value = "xlMoveAndSize"
-Range("B460").Value = 1
-Range("C460").Value = num
-B460 = Range("B460").Value
-C460 = Range("C460").Value
-If B460 = C460 Then
-Range("D460").Value = "OK"
-Else
-Range("D460").Value = "NG"
-End If
-End Function
-
-Function test_xlMacintosh(ByRef num)
-Range("A461").Clear
-Range("B461").Clear
-Range("C461").Clear
-Range("D461").Clear
-Range("A461").Value = "xlMacintosh"
-Range("B461").Value = 1
-Range("C461").Value = num
-B461 = Range("B461").Value
-C461 = Range("C461").Value
-If B461 = C461 Then
-Range("D461").Value = "OK"
-Else
-Range("D461").Value = "NG"
-End If
-End Function
-
-Function test_xlMSDOS(ByRef num)
-Range("A462").Clear
-Range("B462").Clear
-Range("C462").Clear
-Range("D462").Clear
-Range("A462").Value = "xlMSDOS"
-Range("B462").Value = 3
-Range("C462").Value = num
-B462 = Range("B462").Value
-C462 = Range("C462").Value
-If B462 = C462 Then
-Range("D462").Value = "OK"
-Else
-Range("D462").Value = "NG"
-End If
-End Function
-
-Function test_xlWindows(ByRef num)
-Range("A463").Clear
-Range("B463").Clear
-Range("C463").Clear
-Range("D463").Clear
-Range("A463").Value = "xlWindows"
-Range("B463").Value = 2
-Range("C463").Value = num
-B463 = Range("B463").Value
-C463 = Range("C463").Value
-If B463 = C463 Then
-Range("D463").Value = "OK"
-Else
-Range("D463").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintErrorsBlank(ByRef num)
-Range("A464").Clear
-Range("B464").Clear
-Range("C464").Clear
-Range("D464").Clear
-Range("A464").Value = "xlPrintErrorsBlank"
-Range("B464").Value = 1
-Range("C464").Value = num
-B464 = Range("B464").Value
-C464 = Range("C464").Value
-If B464 = C464 Then
-Range("D464").Value = "OK"
-Else
-Range("D464").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintErrorsDash(ByRef num)
-Range("A465").Clear
-Range("B465").Clear
-Range("C465").Clear
-Range("D465").Clear
-Range("A465").Value = "xlPrintErrorsDash"
-Range("B465").Value = 2
-Range("C465").Value = num
-B465 = Range("B465").Value
-C465 = Range("C465").Value
-If B465 = C465 Then
-Range("D465").Value = "OK"
-Else
-Range("D465").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintErrorsDisplayed(ByRef num)
-Range("A466").Clear
-Range("B466").Clear
-Range("C466").Clear
-Range("D466").Clear
-Range("A466").Value = "xlPrintErrorsDisplayed"
-Range("B466").Value = 0
-Range("C466").Value = num
-B466 = Range("B466").Value
-C466 = Range("C466").Value
-If B466 = C466 Then
-Range("D466").Value = "OK"
-Else
-Range("D466").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintErrorsNA(ByRef num)
-Range("A467").Clear
-Range("B467").Clear
-Range("C467").Clear
-Range("D467").Clear
-Range("A467").Value = "xlPrintErrorsNA"
-Range("B467").Value = 3
-Range("C467").Value = num
-B467 = Range("B467").Value
-C467 = Range("C467").Value
-If B467 = C467 Then
-Range("D467").Value = "OK"
-Else
-Range("D467").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintLocation(ByRef num)
-Range("A468").Clear
-Range("B468").Clear
-Range("C468").Clear
-Range("D468").Clear
-Range("A468").Value = "xlPrintLocation"
-Range("B468").Value = 16
-Range("C468").Value = num
-B468 = Range("B468").Value
-C468 = Range("C468").Value
-If B468 = C468 Then
-Range("D468").Value = "OK"
-Else
-Range("D468").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintNoComments(ByRef num)
-Range("A469").Clear
-Range("B469").Clear
-Range("C469").Clear
-Range("D469").Clear
-Range("A469").Value = "xlPrintNoComments"
-Range("B469").Value = -4142
-Range("C469").Value = num
-B469 = Range("B469").Value
-C469 = Range("C469").Value
-If B469 = C469 Then
-Range("D469").Value = "OK"
-Else
-Range("D469").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintSheetEnd(ByRef num)
-Range("A470").Clear
-Range("B470").Clear
-Range("C470").Clear
-Range("D470").Clear
-Range("A470").Value = "xlPrintSheetEnd"
-Range("B470").Value = 1
-Range("C470").Value = num
-B470 = Range("B470").Value
-C470 = Range("C470").Value
-If B470 = C470 Then
-Range("D470").Value = "OK"
-Else
-Range("D470").Value = "NG"
-End If
-End Function
-
-Function test_xlPriorityHigh(ByRef num)
-Range("A471").Clear
-Range("B471").Clear
-Range("C471").Clear
-Range("D471").Clear
-Range("A471").Value = "xlPriorityHigh"
-Range("B471").Value = -4127
-Range("C471").Value = num
-B471 = Range("B471").Value
-C471 = Range("C471").Value
-If B471 = C471 Then
-Range("D471").Value = "OK"
-Else
-Range("D471").Value = "NG"
-End If
-End Function
-
-Function test_xlPriorityLow(ByRef num)
-Range("A472").Clear
-Range("B472").Clear
-Range("C472").Clear
-Range("D472").Clear
-Range("A472").Value = "xlPriorityLow"
-Range("B472").Value = -4134
-Range("C472").Value = num
-B472 = Range("B472").Value
-C472 = Range("C472").Value
-If B472 = C472 Then
-Range("D472").Value = "OK"
-Else
-Range("D472").Value = "NG"
-End If
-End Function
-
-Function test_xlPriorityNormal(ByRef num)
-Range("A473").Clear
-Range("B473").Clear
-Range("C473").Clear
-Range("D473").Clear
-Range("A473").Value = "xlPriorityNormal"
-Range("B473").Value = -4143
-Range("C473").Value = num
-B473 = Range("B473").Value
-C473 = Range("C473").Value
-If B473 = C473 Then
-Range("D473").Value = "OK"
-Else
-Range("D473").Value = "NG"
-End If
-End Function
-
-Function test_xlADORecordset(ByRef num)
-Range("A474").Clear
-Range("B474").Clear
-Range("C474").Clear
-Range("D474").Clear
-Range("A474").Value = "xlADORecordset"
-Range("B474").Value = 7
-Range("C474").Value = num
-B474 = Range("B474").Value
-C474 = Range("C474").Value
-If B474 = C474 Then
-Range("D474").Value = "OK"
-Else
-Range("D474").Value = "NG"
-End If
-End Function
-
-Function test_xlDAORecordset(ByRef num)
-Range("A475").Clear
-Range("B475").Clear
-Range("C475").Clear
-Range("D475").Clear
-Range("A475").Value = "xlDAORecordset"
-Range("B475").Value = 2
-Range("C475").Value = num
-B475 = Range("B475").Value
-C475 = Range("C475").Value
-If B475 = C475 Then
-Range("D475").Value = "OK"
-Else
-Range("D475").Value = "NG"
-End If
-End Function
-
-Function test_xlODBCQuery(ByRef num)
-Range("A476").Clear
-Range("B476").Clear
-Range("C476").Clear
-Range("D476").Clear
-Range("A476").Value = "xlODBCQuery"
-Range("B476").Value = 1
-Range("C476").Value = num
-B476 = Range("B476").Value
-C476 = Range("C476").Value
-If B476 = C476 Then
-Range("D476").Value = "OK"
-Else
-Range("D476").Value = "NG"
-End If
-End Function
-
-Function test_xlOLEDBQuery(ByRef num)
-Range("A477").Clear
-Range("B477").Clear
-Range("C477").Clear
-Range("D477").Clear
-Range("A477").Value = "xlOLEDBQuery"
-Range("B477").Value = 5
-Range("C477").Value = num
-B477 = Range("B477").Value
-C477 = Range("C477").Value
-If B477 = C477 Then
-Range("D477").Value = "OK"
-Else
-Range("D477").Value = "NG"
-End If
-End Function
-
-Function test_xlTextImport(ByRef num)
-Range("A478").Clear
-Range("B478").Clear
-Range("C478").Clear
-Range("D478").Clear
-Range("A478").Value = "xlTextImport"
-Range("B478").Value = 6
-Range("C478").Value = num
-B478 = Range("B478").Value
-C478 = Range("C478").Value
-If B478 = C478 Then
-Range("D478").Value = "OK"
-Else
-Range("D478").Value = "NG"
-End If
-End Function
-
-Function test_xlWebQuery(ByRef num)
-Range("A479").Clear
-Range("B479").Clear
-Range("C479").Clear
-Range("D479").Clear
-Range("A479").Value = "xlWebQuery"
-Range("B479").Value = 4
-Range("C479").Value = num
-B479 = Range("B479").Value
-C479 = Range("C479").Value
-If B479 = C479 Then
-Range("D479").Value = "OK"
-Else
-Range("D479").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormat3DEffects1(ByRef num)
-Range("A480").Clear
-Range("B480").Clear
-Range("C480").Clear
-Range("D480").Clear
-Range("A480").Value = "xlRangeAutoFormat3DEffects1"
-Range("B480").Value = 13
-Range("C480").Value = num
-B480 = Range("B480").Value
-C480 = Range("C480").Value
-If B480 = C480 Then
-Range("D480").Value = "OK"
-Else
-Range("D480").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormat3DEffects2(ByRef num)
-Range("A481").Clear
-Range("B481").Clear
-Range("C481").Clear
-Range("D481").Clear
-Range("A481").Value = "xlRangeAutoFormat3DEffects2"
-Range("B481").Value = 14
-Range("C481").Value = num
-B481 = Range("B481").Value
-C481 = Range("C481").Value
-If B481 = C481 Then
-Range("D481").Value = "OK"
-Else
-Range("D481").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatAccounting1(ByRef num)
-Range("A482").Clear
-Range("B482").Clear
-Range("C482").Clear
-Range("D482").Clear
-Range("A482").Value = "xlRangeAutoFormatAccounting1"
-Range("B482").Value = 4
-Range("C482").Value = num
-B482 = Range("B482").Value
-C482 = Range("C482").Value
-If B482 = C482 Then
-Range("D482").Value = "OK"
-Else
-Range("D482").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatAccounting2(ByRef num)
-Range("A483").Clear
-Range("B483").Clear
-Range("C483").Clear
-Range("D483").Clear
-Range("A483").Value = "xlRangeAutoFormatAccounting2"
-Range("B483").Value = 5
-Range("C483").Value = num
-B483 = Range("B483").Value
-C483 = Range("C483").Value
-If B483 = C483 Then
-Range("D483").Value = "OK"
-Else
-Range("D483").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatAccounting3(ByRef num)
-Range("A484").Clear
-Range("B484").Clear
-Range("C484").Clear
-Range("D484").Clear
-Range("A484").Value = "xlRangeAutoFormatAccounting3"
-Range("B484").Value = 6
-Range("C484").Value = num
-B484 = Range("B484").Value
-C484 = Range("C484").Value
-If B484 = C484 Then
-Range("D484").Value = "OK"
-Else
-Range("D484").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatAccounting4(ByRef num)
-Range("A485").Clear
-Range("B485").Clear
-Range("C485").Clear
-Range("D485").Clear
-Range("A485").Value = "xlRangeAutoFormatAccounting4"
-Range("B485").Value = 17
-Range("C485").Value = num
-B485 = Range("B485").Value
-C485 = Range("C485").Value
-If B485 = C485 Then
-Range("D485").Value = "OK"
-Else
-Range("D485").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatClassic1(ByRef num)
-Range("A486").Clear
-Range("B486").Clear
-Range("C486").Clear
-Range("D486").Clear
-Range("A486").Value = "xlRangeAutoFormatClassic1"
-Range("B486").Value = 1
-Range("C486").Value = num
-B486 = Range("B486").Value
-C486 = Range("C486").Value
-If B486 = C486 Then
-Range("D486").Value = "OK"
-Else
-Range("D486").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatClassic2(ByRef num)
-Range("A487").Clear
-Range("B487").Clear
-Range("C487").Clear
-Range("D487").Clear
-Range("A487").Value = "xlRangeAutoFormatClassic2"
-Range("B487").Value = 2
-Range("C487").Value = num
-B487 = Range("B487").Value
-C487 = Range("C487").Value
-If B487 = C487 Then
-Range("D487").Value = "OK"
-Else
-Range("D487").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatClassic3(ByRef num)
-Range("A488").Clear
-Range("B488").Clear
-Range("C488").Clear
-Range("D488").Clear
-Range("A488").Value = "xlRangeAutoFormatClassic3"
-Range("B488").Value = 3
-Range("C488").Value = num
-B488 = Range("B488").Value
-C488 = Range("C488").Value
-If B488 = C488 Then
-Range("D488").Value = "OK"
-Else
-Range("D488").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatClassicPivotTable(ByRef num)
-Range("A489").Clear
-Range("B489").Clear
-Range("C489").Clear
-Range("D489").Clear
-Range("A489").Value = "xlRangeAutoFormatClassicPivotTable"
-Range("B489").Value = 31
-Range("C489").Value = num
-B489 = Range("B489").Value
-C489 = Range("C489").Value
-If B489 = C489 Then
-Range("D489").Value = "OK"
-Else
-Range("D489").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatColor1(ByRef num)
-Range("A490").Clear
-Range("B490").Clear
-Range("C490").Clear
-Range("D490").Clear
-Range("A490").Value = "xlRangeAutoFormatColor1"
-Range("B490").Value = 7
-Range("C490").Value = num
-B490 = Range("B490").Value
-C490 = Range("C490").Value
-If B490 = C490 Then
-Range("D490").Value = "OK"
-Else
-Range("D490").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatColor2(ByRef num)
-Range("A491").Clear
-Range("B491").Clear
-Range("C491").Clear
-Range("D491").Clear
-Range("A491").Value = "xlRangeAutoFormatColor2"
-Range("B491").Value = 8
-Range("C491").Value = num
-B491 = Range("B491").Value
-C491 = Range("C491").Value
-If B491 = C491 Then
-Range("D491").Value = "OK"
-Else
-Range("D491").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatColor3(ByRef num)
-Range("A492").Clear
-Range("B492").Clear
-Range("C492").Clear
-Range("D492").Clear
-Range("A492").Value = "xlRangeAutoFormatColor3"
-Range("B492").Value = 9
-Range("C492").Value = num
-B492 = Range("B492").Value
-C492 = Range("C492").Value
-If B492 = C492 Then
-Range("D492").Value = "OK"
-Else
-Range("D492").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatList1(ByRef num)
-Range("A493").Clear
-Range("B493").Clear
-Range("C493").Clear
-Range("D493").Clear
-Range("A493").Value = "xlRangeAutoFormatList1"
-Range("B493").Value = 10
-Range("C493").Value = num
-B493 = Range("B493").Value
-C493 = Range("C493").Value
-If B493 = C493 Then
-Range("D493").Value = "OK"
-Else
-Range("D493").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatList2(ByRef num)
-Range("A494").Clear
-Range("B494").Clear
-Range("C494").Clear
-Range("D494").Clear
-Range("A494").Value = "xlRangeAutoFormatList2"
-Range("B494").Value = 11
-Range("C494").Value = num
-B494 = Range("B494").Value
-C494 = Range("C494").Value
-If B494 = C494 Then
-Range("D494").Value = "OK"
-Else
-Range("D494").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatList3(ByRef num)
-Range("A495").Clear
-Range("B495").Clear
-Range("C495").Clear
-Range("D495").Clear
-Range("A495").Value = "xlRangeAutoFormatList3"
-Range("B495").Value = 12
-Range("C495").Value = num
-B495 = Range("B495").Value
-C495 = Range("C495").Value
-If B495 = C495 Then
-Range("D495").Value = "OK"
-Else
-Range("D495").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatLocalFormat1(ByRef num)
-Range("A496").Clear
-Range("B496").Clear
-Range("C496").Clear
-Range("D496").Clear
-Range("A496").Value = "xlRangeAutoFormatLocalFormat1"
-Range("B496").Value = 15
-Range("C496").Value = num
-B496 = Range("B496").Value
-C496 = Range("C496").Value
-If B496 = C496 Then
-Range("D496").Value = "OK"
-Else
-Range("D496").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatLocalFormat2(ByRef num)
-Range("A497").Clear
-Range("B497").Clear
-Range("C497").Clear
-Range("D497").Clear
-Range("A497").Value = "xlRangeAutoFormatLocalFormat2"
-Range("B497").Value = 16
-Range("C497").Value = num
-B497 = Range("B497").Value
-C497 = Range("C497").Value
-If B497 = C497 Then
-Range("D497").Value = "OK"
-Else
-Range("D497").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatLocalFormat3(ByRef num)
-Range("A498").Clear
-Range("B498").Clear
-Range("C498").Clear
-Range("D498").Clear
-Range("A498").Value = "xlRangeAutoFormatLocalFormat3"
-Range("B498").Value = 19
-Range("C498").Value = num
-B498 = Range("B498").Value
-C498 = Range("C498").Value
-If B498 = C498 Then
-Range("D498").Value = "OK"
-Else
-Range("D498").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatLocalFormat4(ByRef num)
-Range("A499").Clear
-Range("B499").Clear
-Range("C499").Clear
-Range("D499").Clear
-Range("A499").Value = "xlRangeAutoFormatLocalFormat4"
-Range("B499").Value = 20
-Range("C499").Value = num
-B499 = Range("B499").Value
-C499 = Range("C499").Value
-If B499 = C499 Then
-Range("D499").Value = "OK"
-Else
-Range("D499").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatNone(ByRef num)
-Range("A500").Clear
-Range("B500").Clear
-Range("C500").Clear
-Range("D500").Clear
-Range("A500").Value = "xlRangeAutoFormatNone"
-Range("B500").Value = -4142
-Range("C500").Value = num
-B500 = Range("B500").Value
-C500 = Range("C500").Value
-If B500 = C500 Then
-Range("D500").Value = "OK"
-Else
-Range("D500").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatPTNone(ByRef num)
-Range("A501").Clear
-Range("B501").Clear
-Range("C501").Clear
-Range("D501").Clear
-Range("A501").Value = "xlRangeAutoFormatPTNone"
-Range("B501").Value = 42
-Range("C501").Value = num
-B501 = Range("B501").Value
-C501 = Range("C501").Value
-If B501 = C501 Then
-Range("D501").Value = "OK"
-Else
-Range("D501").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport1(ByRef num)
-Range("A502").Clear
-Range("B502").Clear
-Range("C502").Clear
-Range("D502").Clear
-Range("A502").Value = "xlRangeAutoFormatReport1"
-Range("B502").Value = 21
-Range("C502").Value = num
-B502 = Range("B502").Value
-C502 = Range("C502").Value
-If B502 = C502 Then
-Range("D502").Value = "OK"
-Else
-Range("D502").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport10(ByRef num)
-Range("A503").Clear
-Range("B503").Clear
-Range("C503").Clear
-Range("D503").Clear
-Range("A503").Value = "xlRangeAutoFormatReport10"
-Range("B503").Value = 30
-Range("C503").Value = num
-B503 = Range("B503").Value
-C503 = Range("C503").Value
-If B503 = C503 Then
-Range("D503").Value = "OK"
-Else
-Range("D503").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport2(ByRef num)
-Range("A504").Clear
-Range("B504").Clear
-Range("C504").Clear
-Range("D504").Clear
-Range("A504").Value = "xlRangeAutoFormatReport2"
-Range("B504").Value = 22
-Range("C504").Value = num
-B504 = Range("B504").Value
-C504 = Range("C504").Value
-If B504 = C504 Then
-Range("D504").Value = "OK"
-Else
-Range("D504").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport3(ByRef num)
-Range("A505").Clear
-Range("B505").Clear
-Range("C505").Clear
-Range("D505").Clear
-Range("A505").Value = "xlRangeAutoFormatReport3"
-Range("B505").Value = 23
-Range("C505").Value = num
-B505 = Range("B505").Value
-C505 = Range("C505").Value
-If B505 = C505 Then
-Range("D505").Value = "OK"
-Else
-Range("D505").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport4(ByRef num)
-Range("A506").Clear
-Range("B506").Clear
-Range("C506").Clear
-Range("D506").Clear
-Range("A506").Value = "xlRangeAutoFormatReport4"
-Range("B506").Value = 24
-Range("C506").Value = num
-B506 = Range("B506").Value
-C506 = Range("C506").Value
-If B506 = C506 Then
-Range("D506").Value = "OK"
-Else
-Range("D506").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport5(ByRef num)
-Range("A507").Clear
-Range("B507").Clear
-Range("C507").Clear
-Range("D507").Clear
-Range("A507").Value = "xlRangeAutoFormatReport5"
-Range("B507").Value = 25
-Range("C507").Value = num
-B507 = Range("B507").Value
-C507 = Range("C507").Value
-If B507 = C507 Then
-Range("D507").Value = "OK"
-Else
-Range("D507").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport6(ByRef num)
-Range("A508").Clear
-Range("B508").Clear
-Range("C508").Clear
-Range("D508").Clear
-Range("A508").Value = "xlRangeAutoFormatReport6"
-Range("B508").Value = 26
-Range("C508").Value = num
-B508 = Range("B508").Value
-C508 = Range("C508").Value
-If B508 = C508 Then
-Range("D508").Value = "OK"
-Else
-Range("D508").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport7(ByRef num)
-Range("A509").Clear
-Range("B509").Clear
-Range("C509").Clear
-Range("D509").Clear
-Range("A509").Value = "xlRangeAutoFormatReport7"
-Range("B509").Value = 27
-Range("C509").Value = num
-B509 = Range("B509").Value
-C509 = Range("C509").Value
-If B509 = C509 Then
-Range("D509").Value = "OK"
-Else
-Range("D509").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport8(ByRef num)
-Range("A510").Clear
-Range("B510").Clear
-Range("C510").Clear
-Range("D510").Clear
-Range("A510").Value = "xlRangeAutoFormatReport8"
-Range("B510").Value = 28
-Range("C510").Value = num
-B510 = Range("B510").Value
-C510 = Range("C510").Value
-If B510 = C510 Then
-Range("D510").Value = "OK"
-Else
-Range("D510").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport9(ByRef num)
-Range("A511").Clear
-Range("B511").Clear
-Range("C511").Clear
-Range("D511").Clear
-Range("A511").Value = "xlRangeAutoFormatReport9"
-Range("B511").Value = 29
-Range("C511").Value = num
-B511 = Range("B511").Value
-C511 = Range("C511").Value
-If B511 = C511 Then
-Range("D511").Value = "OK"
-Else
-Range("D511").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatSimple(ByRef num)
-Range("A512").Clear
-Range("B512").Clear
-Range("C512").Clear
-Range("D512").Clear
-Range("A512").Value = "xlRangeAutoFormatSimple"
-Range("B512").Value = -4154
-Range("C512").Value = num
-B512 = Range("B512").Value
-C512 = Range("C512").Value
-If B512 = C512 Then
-Range("D512").Value = "OK"
-Else
-Range("D512").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable1(ByRef num)
-Range("A513").Clear
-Range("B513").Clear
-Range("C513").Clear
-Range("D513").Clear
-Range("A513").Value = "xlRangeAutoFormatTable1"
-Range("B513").Value = 32
-Range("C513").Value = num
-B513 = Range("B513").Value
-C513 = Range("C513").Value
-If B513 = C513 Then
-Range("D513").Value = "OK"
-Else
-Range("D513").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable10(ByRef num)
-Range("A514").Clear
-Range("B514").Clear
-Range("C514").Clear
-Range("D514").Clear
-Range("A514").Value = "xlRangeAutoFormatTable10"
-Range("B514").Value = 41
-Range("C514").Value = num
-B514 = Range("B514").Value
-C514 = Range("C514").Value
-If B514 = C514 Then
-Range("D514").Value = "OK"
-Else
-Range("D514").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable2(ByRef num)
-Range("A515").Clear
-Range("B515").Clear
-Range("C515").Clear
-Range("D515").Clear
-Range("A515").Value = "xlRangeAutoFormatTable2"
-Range("B515").Value = 33
-Range("C515").Value = num
-B515 = Range("B515").Value
-C515 = Range("C515").Value
-If B515 = C515 Then
-Range("D515").Value = "OK"
-Else
-Range("D515").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable3(ByRef num)
-Range("A516").Clear
-Range("B516").Clear
-Range("C516").Clear
-Range("D516").Clear
-Range("A516").Value = "xlRangeAutoFormatTable3"
-Range("B516").Value = 34
-Range("C516").Value = num
-B516 = Range("B516").Value
-C516 = Range("C516").Value
-If B516 = C516 Then
-Range("D516").Value = "OK"
-Else
-Range("D516").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable4(ByRef num)
-Range("A517").Clear
-Range("B517").Clear
-Range("C517").Clear
-Range("D517").Clear
-Range("A517").Value = "xlRangeAutoFormatTable4"
-Range("B517").Value = 35
-Range("C517").Value = num
-B517 = Range("B517").Value
-C517 = Range("C517").Value
-If B517 = C517 Then
-Range("D517").Value = "OK"
-Else
-Range("D517").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable5(ByRef num)
-Range("A518").Clear
-Range("B518").Clear
-Range("C518").Clear
-Range("D518").Clear
-Range("A518").Value = "xlRangeAutoFormatTable5"
-Range("B518").Value = 36
-Range("C518").Value = num
-B518 = Range("B518").Value
-C518 = Range("C518").Value
-If B518 = C518 Then
-Range("D518").Value = "OK"
-Else
-Range("D518").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable6(ByRef num)
-Range("A519").Clear
-Range("B519").Clear
-Range("C519").Clear
-Range("D519").Clear
-Range("A519").Value = "xlRangeAutoFormatTable6"
-Range("B519").Value = 37
-Range("C519").Value = num
-B519 = Range("B519").Value
-C519 = Range("C519").Value
-If B519 = C519 Then
-Range("D519").Value = "OK"
-Else
-Range("D519").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable7(ByRef num)
-Range("A520").Clear
-Range("B520").Clear
-Range("C520").Clear
-Range("D520").Clear
-Range("A520").Value = "xlRangeAutoFormatTable7"
-Range("B520").Value = 38
-Range("C520").Value = num
-B520 = Range("B520").Value
-C520 = Range("C520").Value
-If B520 = C520 Then
-Range("D520").Value = "OK"
-Else
-Range("D520").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable8(ByRef num)
-Range("A521").Clear
-Range("B521").Clear
-Range("C521").Clear
-Range("D521").Clear
-Range("A521").Value = "xlRangeAutoFormatTable8"
-Range("B521").Value = 39
-Range("C521").Value = num
-B521 = Range("B521").Value
-C521 = Range("C521").Value
-If B521 = C521 Then
-Range("D521").Value = "OK"
-Else
-Range("D521").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable9(ByRef num)
-Range("A522").Clear
-Range("B522").Clear
-Range("C522").Clear
-Range("D522").Clear
-Range("A522").Value = "xlRangeAutoFormatTable9"
-Range("B522").Value = 40
-Range("C522").Value = num
-B522 = Range("B522").Value
-C522 = Range("C522").Value
-If B522 = C522 Then
-Range("D522").Value = "OK"
-Else
-Range("D522").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeValueDefault(ByRef num)
-Range("A523").Clear
-Range("B523").Clear
-Range("C523").Clear
-Range("D523").Clear
-Range("A523").Value = "xlRangeValueDefault"
-Range("B523").Value = 10
-Range("C523").Value = num
-B523 = Range("B523").Value
-C523 = Range("C523").Value
-If B523 = C523 Then
-Range("D523").Value = "OK"
-Else
-Range("D523").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeValueMSPersistXML(ByRef num)
-Range("A524").Clear
-Range("B524").Clear
-Range("C524").Clear
-Range("D524").Clear
-Range("A524").Value = "xlRangeValueMSPersistXML"
-Range("B524").Value = 12
-Range("C524").Value = num
-B524 = Range("B524").Value
-C524 = Range("C524").Value
-If B524 = C524 Then
-Range("D524").Value = "OK"
-Else
-Range("D524").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeValueXMLSpreadsheet(ByRef num)
-Range("A525").Clear
-Range("B525").Clear
-Range("C525").Clear
-Range("D525").Clear
-Range("A525").Value = "xlRangeValueXMLSpreadsheet"
-Range("B525").Value = 11
-Range("C525").Value = num
-B525 = Range("B525").Value
-C525 = Range("C525").Value
-If B525 = C525 Then
-Range("D525").Value = "OK"
-Else
-Range("D525").Value = "NG"
-End If
-End Function
-
-Function test_xlA1(ByRef num)
-Range("A526").Clear
-Range("B526").Clear
-Range("C526").Clear
-Range("D526").Clear
-Range("A526").Value = "xlA1"
-Range("B526").Value = 1
-Range("C526").Value = num
-B526 = Range("B526").Value
-C526 = Range("C526").Value
-If B526 = C526 Then
-Range("D526").Value = "OK"
-Else
-Range("D526").Value = "NG"
-End If
-End Function
-
-Function test_xlR1C1(ByRef num)
-Range("A527").Clear
-Range("B527").Clear
-Range("C527").Clear
-Range("D527").Clear
-Range("A527").Value = "xlR1C1"
-Range("B527").Value = -4150
-Range("C527").Value = num
-B527 = Range("B527").Value
-C527 = Range("C527").Value
-If B527 = C527 Then
-Range("D527").Value = "OK"
-Else
-Range("D527").Value = "NG"
-End If
-End Function
-
-Function test_xlAbsolute(ByRef num)
-Range("A528").Clear
-Range("B528").Clear
-Range("C528").Clear
-Range("D528").Clear
-Range("A528").Value = "xlAbsolute"
-Range("B528").Value = 1
-Range("C528").Value = num
-B528 = Range("B528").Value
-C528 = Range("C528").Value
-If B528 = C528 Then
-Range("D528").Value = "OK"
-Else
-Range("D528").Value = "NG"
-End If
-End Function
-
-Function test_xlAbsRowRelColumn(ByRef num)
-Range("A529").Clear
-Range("B529").Clear
-Range("C529").Clear
-Range("D529").Clear
-Range("A529").Value = "xlAbsRowRelColumn"
-Range("B529").Value = 2
-Range("C529").Value = num
-B529 = Range("B529").Value
-C529 = Range("C529").Value
-If B529 = C529 Then
-Range("D529").Value = "OK"
-Else
-Range("D529").Value = "NG"
-End If
-End Function
-
-Function test_xlRelative(ByRef num)
-Range("A530").Clear
-Range("B530").Clear
-Range("C530").Clear
-Range("D530").Clear
-Range("A530").Value = "xlRelative"
-Range("B530").Value = 4
-Range("C530").Value = num
-B530 = Range("B530").Value
-C530 = Range("C530").Value
-If B530 = C530 Then
-Range("D530").Value = "OK"
-Else
-Range("D530").Value = "NG"
-End If
-End Function
-
-Function test_xlRelRowAbsColumn(ByRef num)
-Range("A531").Clear
-Range("B531").Clear
-Range("C531").Clear
-Range("D531").Clear
-Range("A531").Value = "xlRelRowAbsColumn"
-Range("B531").Value = 3
-Range("C531").Value = num
-B531 = Range("B531").Value
-C531 = Range("C531").Value
-If B531 = C531 Then
-Range("D531").Value = "OK"
-Else
-Range("D531").Value = "NG"
-End If
-End Function
-
-Function test_xlAlways(ByRef num)
-Range("A532").Clear
-Range("B532").Clear
-Range("C532").Clear
-Range("D532").Clear
-Range("A532").Value = "xlAlways"
-Range("B532").Value = 1
-Range("C532").Value = num
-B532 = Range("B532").Value
-C532 = Range("C532").Value
-If B532 = C532 Then
-Range("D532").Value = "OK"
-Else
-Range("D532").Value = "NG"
-End If
-End Function
-
-Function test_xlAsRequired(ByRef num)
-Range("A533").Clear
-Range("B533").Clear
-Range("C533").Clear
-Range("D533").Clear
-Range("A533").Value = "xlAsRequired"
-Range("B533").Value = 0
-Range("C533").Value = num
-B533 = Range("B533").Value
-C533 = Range("C533").Value
-If B533 = C533 Then
-Range("D533").Value = "OK"
-Else
-Range("D533").Value = "NG"
-End If
-End Function
-
-Function test_xlNever(ByRef num)
-Range("A534").Clear
-Range("B534").Clear
-Range("C534").Clear
-Range("D534").Clear
-Range("A534").Value = "xlNever"
-Range("B534").Value = 2
-Range("C534").Value = num
-B534 = Range("B534").Value
-C534 = Range("C534").Value
-If B534 = C534 Then
-Range("D534").Value = "OK"
-Else
-Range("D534").Value = "NG"
-End If
-End Function
-
-Function test_xlAllAtOnce(ByRef num)
-Range("A535").Clear
-Range("B535").Clear
-Range("C535").Clear
-Range("D535").Clear
-Range("A535").Value = "xlAllAtOnce"
-Range("B535").Value = 2
-Range("C535").Value = num
-B535 = Range("B535").Value
-C535 = Range("C535").Value
-If B535 = C535 Then
-Range("D535").Value = "OK"
-Else
-Range("D535").Value = "NG"
-End If
-End Function
-
-Function test_xlOneAfterAnother(ByRef num)
-Range("A536").Clear
-Range("B536").Clear
-Range("C536").Clear
-Range("D536").Clear
-Range("A536").Value = "xlOneAfterAnother"
-Range("B536").Value = 1
-Range("C536").Value = num
-B536 = Range("B536").Value
-C536 = Range("C536").Value
-If B536 = C536 Then
-Range("D536").Value = "OK"
-Else
-Range("D536").Value = "NG"
-End If
-End Function
-
-Function test_xlNotYetRouted(ByRef num)
-Range("A537").Clear
-Range("B537").Clear
-Range("C537").Clear
-Range("D537").Clear
-Range("A537").Value = "xlNotYetRouted"
-Range("B537").Value = 0
-Range("C537").Value = num
-B537 = Range("B537").Value
-C537 = Range("C537").Value
-If B537 = C537 Then
-Range("D537").Value = "OK"
-Else
-Range("D537").Value = "NG"
-End If
-End Function
-
-Function test_xlRoutingComplete(ByRef num)
-Range("A538").Clear
-Range("B538").Clear
-Range("C538").Clear
-Range("D538").Clear
-Range("A538").Value = "xlRoutingComplete"
-Range("B538").Value = 2
-Range("C538").Value = num
-B538 = Range("B538").Value
-C538 = Range("C538").Value
-If B538 = C538 Then
-Range("D538").Value = "OK"
-Else
-Range("D538").Value = "NG"
-End If
-End Function
-
-Function test_xlRoutingInProgress(ByRef num)
-Range("A539").Clear
-Range("B539").Clear
-Range("C539").Clear
-Range("D539").Clear
-Range("A539").Value = "xlRoutingInProgress"
-Range("B539").Value = 1
-Range("C539").Value = num
-B539 = Range("B539").Value
-C539 = Range("C539").Value
-If B539 = C539 Then
-Range("D539").Value = "OK"
-Else
-Range("D539").Value = "NG"
-End If
-End Function
-
-Function test_xlColumns(ByRef num)
-Range("A540").Clear
-Range("B540").Clear
-Range("C540").Clear
-Range("D540").Clear
-Range("A540").Value = "xlColumns"
-Range("B540").Value = 2
-Range("C540").Value = num
-B540 = Range("B540").Value
-C540 = Range("C540").Value
-If B540 = C540 Then
-Range("D540").Value = "OK"
-Else
-Range("D540").Value = "NG"
-End If
-End Function
-
-Function test_xlRows(ByRef num)
-Range("A541").Clear
-Range("B541").Clear
-Range("C541").Clear
-Range("D541").Clear
-Range("A541").Value = "xlRows"
-Range("B541").Value = 1
-Range("C541").Value = num
-B541 = Range("B541").Value
-C541 = Range("C541").Value
-If B541 = C541 Then
-Range("D541").Value = "OK"
-Else
-Range("D541").Value = "NG"
-End If
-End Function
-
-Function test_xlAutoActivate(ByRef num)
-Range("A542").Clear
-Range("B542").Clear
-Range("C542").Clear
-Range("D542").Clear
-Range("A542").Value = "xlAutoActivate"
-Range("B542").Value = 3
-Range("C542").Value = num
-B542 = Range("B542").Value
-C542 = Range("C542").Value
-If B542 = C542 Then
-Range("D542").Value = "OK"
-Else
-Range("D542").Value = "NG"
-End If
-End Function
-
-Function test_xlAutoClose(ByRef num)
-Range("A543").Clear
-Range("B543").Clear
-Range("C543").Clear
-Range("D543").Clear
-Range("A543").Value = "xlAutoClose"
-Range("B543").Value = 2
-Range("C543").Value = num
-B543 = Range("B543").Value
-C543 = Range("C543").Value
-If B543 = C543 Then
-Range("D543").Value = "OK"
-Else
-Range("D543").Value = "NG"
-End If
-End Function
-
-Function test_xlAutoDeactivate(ByRef num)
-Range("A544").Clear
-Range("B544").Clear
-Range("C544").Clear
-Range("D544").Clear
-Range("A544").Value = "xlAutoDeactivate"
-Range("B544").Value = 4
-Range("C544").Value = num
-B544 = Range("B544").Value
-C544 = Range("C544").Value
-If B544 = C544 Then
-Range("D544").Value = "OK"
-Else
-Range("D544").Value = "NG"
-End If
-End Function
-
-Function test_xlAutoOpen(ByRef num)
-Range("A545").Clear
-Range("B545").Clear
-Range("C545").Clear
-Range("D545").Clear
-Range("A545").Value = "xlAutoOpen"
-Range("B545").Value = 1
-Range("C545").Value = num
-B545 = Range("B545").Value
-C545 = Range("C545").Value
-If B545 = C545 Then
-Range("D545").Value = "OK"
-Else
-Range("D545").Value = "NG"
-End If
-End Function
-
-Function test_xlDoNotSaveChanges(ByRef num)
-Range("A546").Clear
-Range("B546").Clear
-Range("C546").Clear
-Range("D546").Clear
-Range("A546").Value = "xlDoNotSaveChanges"
-Range("B546").Value = 2
-Range("C546").Value = num
-B546 = Range("B546").Value
-C546 = Range("C546").Value
-If B546 = C546 Then
-Range("D546").Value = "OK"
-Else
-Range("D546").Value = "NG"
-End If
-End Function
-
-Function test_xlSaveChanges(ByRef num)
-Range("A547").Clear
-Range("B547").Clear
-Range("C547").Clear
-Range("D547").Clear
-Range("A547").Value = "xlSaveChanges"
-Range("B547").Value = 1
-Range("C547").Value = num
-B547 = Range("B547").Value
-C547 = Range("C547").Value
-If B547 = C547 Then
-Range("D547").Value = "OK"
-Else
-Range("D547").Value = "NG"
-End If
-End Function
-
-Function test_xlExclusive(ByRef num)
-Range("A548").Clear
-Range("B548").Clear
-Range("C548").Clear
-Range("D548").Clear
-Range("A548").Value = "xlExclusive"
-Range("B548").Value = 3
-Range("C548").Value = num
-B548 = Range("B548").Value
-C548 = Range("C548").Value
-If B548 = C548 Then
-Range("D548").Value = "OK"
-Else
-Range("D548").Value = "NG"
-End If
-End Function
-
-Function test_xlNoChange(ByRef num)
-Range("A549").Clear
-Range("B549").Clear
-Range("C549").Clear
-Range("D549").Clear
-Range("A549").Value = "xlNoChange"
-Range("B549").Value = 1
-Range("C549").Value = num
-B549 = Range("B549").Value
-C549 = Range("C549").Value
-If B549 = C549 Then
-Range("D549").Value = "OK"
-Else
-Range("D549").Value = "NG"
-End If
-End Function
-
-Function test_xlShared(ByRef num)
-Range("A550").Clear
-Range("B550").Clear
-Range("C550").Clear
-Range("D550").Clear
-Range("A550").Value = "xlShared"
-Range("B550").Value = 2
-Range("C550").Value = num
-B550 = Range("B550").Value
-C550 = Range("C550").Value
-If B550 = C550 Then
-Range("D550").Value = "OK"
-Else
-Range("D550").Value = "NG"
-End If
-End Function
-
-Function test_xlLocalSessionsChanges(ByRef num)
-Range("A551").Clear
-Range("B551").Clear
-Range("C551").Clear
-Range("D551").Clear
-Range("A551").Value = "xlLocalSessionsChanges"
-Range("B551").Value = 2
-Range("C551").Value = num
-B551 = Range("B551").Value
-C551 = Range("C551").Value
-If B551 = C551 Then
-Range("D551").Value = "OK"
-Else
-Range("D551").Value = "NG"
-End If
-End Function
-
-Function test_xlOtherSessionsChanges(ByRef num)
-Range("A552").Clear
-Range("B552").Clear
-Range("C552").Clear
-Range("D552").Clear
-Range("A552").Value = "xlOtherSessionsChanges"
-Range("B552").Value = 3
-Range("C552").Value = num
-B552 = Range("B552").Value
-C552 = Range("C552").Value
-If B552 = C552 Then
-Range("D552").Value = "OK"
-Else
-Range("D552").Value = "NG"
-End If
-End Function
-
-Function test_xlUserResolution(ByRef num)
-Range("A553").Clear
-Range("B553").Clear
-Range("C553").Clear
-Range("D553").Clear
-Range("A553").Value = "xlUserResolution"
-Range("B553").Value = 1
-Range("C553").Value = num
-B553 = Range("B553").Value
-C553 = Range("C553").Value
-If B553 = C553 Then
-Range("D553").Value = "OK"
-Else
-Range("D553").Value = "NG"
-End If
-End Function
-
-Function test_xlScaleLinear(ByRef num)
-Range("A554").Clear
-Range("B554").Clear
-Range("C554").Clear
-Range("D554").Clear
-Range("A554").Value = "xlScaleLinear"
-Range("B554").Value = -4132
-Range("C554").Value = num
-B554 = Range("B554").Value
-C554 = Range("C554").Value
-If B554 = C554 Then
-Range("D554").Value = "OK"
-Else
-Range("D554").Value = "NG"
-End If
-End Function
-
-Function test_xlScaleLogarithmicr(ByRef num)
-Range("A555").Clear
-Range("B555").Clear
-Range("C555").Clear
-Range("D555").Clear
-Range("A555").Value = "xlScaleLogarithmicr"
-Range("B555").Value = -4133
-Range("C555").Value = num
-B555 = Range("B555").Value
-C555 = Range("C555").Value
-If B555 = C555 Then
-Range("D555").Value = "OK"
-Else
-Range("D555").Value = "NG"
-End If
-End Function
-
-Function test_xlNext(ByRef num)
-Range("A556").Clear
-Range("B556").Clear
-Range("C556").Clear
-Range("D556").Clear
-Range("A556").Value = "xlNext"
-Range("B556").Value = 1
-Range("C556").Value = num
-B556 = Range("B556").Value
-C556 = Range("C556").Value
-If B556 = C556 Then
-Range("D556").Value = "OK"
-Else
-Range("D556").Value = "NG"
-End If
-End Function
-
-Function test_xlPrevious(ByRef num)
-Range("A557").Clear
-Range("B557").Clear
-Range("C557").Clear
-Range("D557").Clear
-Range("A557").Value = "xlPrevious"
-Range("B557").Value = 2
-Range("C557").Value = num
-B557 = Range("B557").Value
-C557 = Range("C557").Value
-If B557 = C557 Then
-Range("D557").Value = "OK"
-Else
-Range("D557").Value = "NG"
-End If
-End Function
-
-Function test_xlByColumns(ByRef num)
-Range("A558").Clear
-Range("B558").Clear
-Range("C558").Clear
-Range("D558").Clear
-Range("A558").Value = "xlByColumns"
-Range("B558").Value = 2
-Range("C558").Value = num
-B558 = Range("B558").Value
-C558 = Range("C558").Value
-If B558 = C558 Then
-Range("D558").Value = "OK"
-Else
-Range("D558").Value = "NG"
-End If
-End Function
-
-Function test_xlByRows(ByRef num)
-Range("A559").Clear
-Range("B559").Clear
-Range("C559").Clear
-Range("D559").Clear
-Range("A559").Value = "xlByRows"
-Range("B559").Value = 1
-Range("C559").Value = num
-B559 = Range("B559").Value
-C559 = Range("C559").Value
-If B559 = C559 Then
-Range("D559").Value = "OK"
-Else
-Range("D559").Value = "NG"
-End If
-End Function
-
-Function test_xlWithinSheet(ByRef num)
-Range("A560").Clear
-Range("B560").Clear
-Range("C560").Clear
-Range("D560").Clear
-Range("A560").Value = "xlWithinSheet"
-Range("B560").Value = 1
-Range("C560").Value = num
-B560 = Range("B560").Value
-C560 = Range("C560").Value
-If B560 = C560 Then
-Range("D560").Value = "OK"
-Else
-Range("D560").Value = "NG"
-End If
-End Function
-
-Function test_xlWithinWorkbook(ByRef num)
-Range("A561").Clear
-Range("B561").Clear
-Range("C561").Clear
-Range("D561").Clear
-Range("A561").Value = "xlWithinWorkbook"
-Range("B561").Value = 2
-Range("C561").Value = num
-B561 = Range("B561").Value
-C561 = Range("C561").Value
-If B561 = C561 Then
-Range("D561").Value = "OK"
-Else
-Range("D561").Value = "NG"
-End If
-End Function
-
-Function test_xlChart(ByRef num)
-Range("A562").Clear
-Range("B562").Clear
-Range("C562").Clear
-Range("D562").Clear
-Range("A562").Value = "xlChart"
-Range("B562").Value = -4109
-Range("C562").Value = num
-B562 = Range("B562").Value
-C562 = Range("C562").Value
-If B562 = C562 Then
-Range("D562").Value = "OK"
-Else
-Range("D562").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSheet(ByRef num)
-Range("A563").Clear
-Range("B563").Clear
-Range("C563").Clear
-Range("D563").Clear
-Range("A563").Value = "xlDialogSheet"
-Range("B563").Value = -4116
-Range("C563").Value = num
-B563 = Range("B563").Value
-C563 = Range("C563").Value
-If B563 = C563 Then
-Range("D563").Value = "OK"
-Else
-Range("D563").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel4IntMacroSheet(ByRef num)
-Range("A564").Clear
-Range("B564").Clear
-Range("C564").Clear
-Range("D564").Clear
-Range("A564").Value = "xlExcel4IntMacroSheet"
-Range("B564").Value = 4
-Range("C564").Value = num
-B564 = Range("B564").Value
-C564 = Range("C564").Value
-If B564 = C564 Then
-Range("D564").Value = "OK"
-Else
-Range("D564").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel4MacroSheet(ByRef num)
-Range("A565").Clear
-Range("B565").Clear
-Range("C565").Clear
-Range("D565").Clear
-Range("A565").Value = "xlExcel4MacroSheet"
-Range("B565").Value = 3
-Range("C565").Value = num
-B565 = Range("B565").Value
-C565 = Range("C565").Value
-If B565 = C565 Then
-Range("D565").Value = "OK"
-Else
-Range("D565").Value = "NG"
-End If
-End Function
-
-Function test_xlWorkSheet(ByRef num)
-Range("A566").Clear
-Range("B566").Clear
-Range("C566").Clear
-Range("D566").Clear
-Range("A566").Value = "xlWorkSheet"
-Range("B566").Value = -4167
-Range("C566").Value = num
-B566 = Range("B566").Value
-C566 = Range("C566").Value
-If B566 = C566 Then
-Range("D566").Value = "OK"
-Else
-Range("D566").Value = "NG"
-End If
-End Function
-
-Function test_xlSheetHidden(ByRef num)
-Range("A567").Clear
-Range("B567").Clear
-Range("C567").Clear
-Range("D567").Clear
-Range("A567").Value = "xlSheetHidden"
-Range("B567").Value = 0
-Range("C567").Value = num
-B567 = Range("B567").Value
-C567 = Range("C567").Value
-If B567 = C567 Then
-Range("D567").Value = "OK"
-Else
-Range("D567").Value = "NG"
-End If
-End Function
-
-Function test_xlSheetVeryHidden(ByRef num)
-Range("A568").Clear
-Range("B568").Clear
-Range("C568").Clear
-Range("D568").Clear
-Range("A568").Value = "xlSheetVeryHidden"
-Range("B568").Value = 2
-Range("C568").Value = num
-B568 = Range("B568").Value
-C568 = Range("C568").Value
-If B568 = C568 Then
-Range("D568").Value = "OK"
-Else
-Range("D568").Value = "NG"
-End If
-End Function
-
-Function test_xlSheetVisible(ByRef num)
-Range("A569").Clear
-Range("B569").Clear
-Range("C569").Clear
-Range("D569").Clear
-Range("A569").Value = "xlSheetVisible"
-Range("B569").Value = -1
-Range("C569").Value = num
-B569 = Range("B569").Value
-C569 = Range("C569").Value
-If B569 = C569 Then
-Range("D569").Value = "OK"
-Else
-Range("D569").Value = "NG"
-End If
-End Function
-
-Function test_xlSizeIsArea(ByRef num)
-Range("A570").Clear
-Range("B570").Clear
-Range("C570").Clear
-Range("D570").Clear
-Range("A570").Value = "xlSizeIsArea"
-Range("B570").Value = 1
-Range("C570").Value = num
-B570 = Range("B570").Value
-C570 = Range("C570").Value
-If B570 = C570 Then
-Range("D570").Value = "OK"
-Else
-Range("D570").Value = "NG"
-End If
-End Function
-
-Function test_xlSizeIsWidth(ByRef num)
-Range("A571").Clear
-Range("B571").Clear
-Range("C571").Clear
-Range("D571").Clear
-Range("A571").Value = "xlSizeIsWidth"
-Range("B571").Value = 2
-Range("C571").Value = num
-B571 = Range("B571").Value
-C571 = Range("C571").Value
-If B571 = C571 Then
-Range("D571").Value = "OK"
-Else
-Range("D571").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlActiveX(ByRef num)
-Range("A572").Clear
-Range("B572").Clear
-Range("C572").Clear
-Range("D572").Clear
-Range("A572").Value = "xlSmartTagControlActiveX"
-Range("B572").Value = 13
-Range("C572").Value = num
-B572 = Range("B572").Value
-C572 = Range("C572").Value
-If B572 = C572 Then
-Range("D572").Value = "OK"
-Else
-Range("D572").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlButton(ByRef num)
-Range("A573").Clear
-Range("B573").Clear
-Range("C573").Clear
-Range("D573").Clear
-Range("A573").Value = "xlSmartTagControlButton"
-Range("B573").Value = 6
-Range("C573").Value = num
-B573 = Range("B573").Value
-C573 = Range("C573").Value
-If B573 = C573 Then
-Range("D573").Value = "OK"
-Else
-Range("D573").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlCheckbox(ByRef num)
-Range("A574").Clear
-Range("B574").Clear
-Range("C574").Clear
-Range("D574").Clear
-Range("A574").Value = "xlSmartTagControlCheckbox"
-Range("B574").Value = 9
-Range("C574").Value = num
-B574 = Range("B574").Value
-C574 = Range("C574").Value
-If B574 = C574 Then
-Range("D574").Value = "OK"
-Else
-Range("D574").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlCombo(ByRef num)
-Range("A575").Clear
-Range("B575").Clear
-Range("C575").Clear
-Range("D575").Clear
-Range("A575").Value = "xlSmartTagControlCombo"
-Range("B575").Value = 12
-Range("C575").Value = num
-B575 = Range("B575").Value
-C575 = Range("C575").Value
-If B575 = C575 Then
-Range("D575").Value = "OK"
-Else
-Range("D575").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlHelp(ByRef num)
-Range("A576").Clear
-Range("B576").Clear
-Range("C576").Clear
-Range("D576").Clear
-Range("A576").Value = "xlSmartTagControlHelp"
-Range("B576").Value = 3
-Range("C576").Value = num
-B576 = Range("B576").Value
-C576 = Range("C576").Value
-If B576 = C576 Then
-Range("D576").Value = "OK"
-Else
-Range("D576").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlHelpURL(ByRef num)
-Range("A577").Clear
-Range("B577").Clear
-Range("C577").Clear
-Range("D577").Clear
-Range("A577").Value = "xlSmartTagControlHelpURL"
-Range("B577").Value = 4
-Range("C577").Value = num
-B577 = Range("B577").Value
-C577 = Range("C577").Value
-If B577 = C577 Then
-Range("D577").Value = "OK"
-Else
-Range("D577").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlImage(ByRef num)
-Range("A578").Clear
-Range("B578").Clear
-Range("C578").Clear
-Range("D578").Clear
-Range("A578").Value = "xlSmartTagControlImage"
-Range("B578").Value = 8
-Range("C578").Value = num
-B578 = Range("B578").Value
-C578 = Range("C578").Value
-If B578 = C578 Then
-Range("D578").Value = "OK"
-Else
-Range("D578").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlLabel(ByRef num)
-Range("A579").Clear
-Range("B579").Clear
-Range("C579").Clear
-Range("D579").Clear
-Range("A579").Value = "xlSmartTagControlLabel"
-Range("B579").Value = 7
-Range("C579").Value = num
-B579 = Range("B579").Value
-C579 = Range("C579").Value
-If B579 = C579 Then
-Range("D579").Value = "OK"
-Else
-Range("D579").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlLink(ByRef num)
-Range("A580").Clear
-Range("B580").Clear
-Range("C580").Clear
-Range("D580").Clear
-Range("A580").Value = "xlSmartTagControlLink"
-Range("B580").Value = 2
-Range("C580").Value = num
-B580 = Range("B580").Value
-C580 = Range("C580").Value
-If B580 = C580 Then
-Range("D580").Value = "OK"
-Else
-Range("D580").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlListbox(ByRef num)
-Range("A581").Clear
-Range("B581").Clear
-Range("C581").Clear
-Range("D581").Clear
-Range("A581").Value = "xlSmartTagControlListbox"
-Range("B581").Value = 11
-Range("C581").Value = num
-B581 = Range("B581").Value
-C581 = Range("C581").Value
-If B581 = C581 Then
-Range("D581").Value = "OK"
-Else
-Range("D581").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlRadioGroup(ByRef num)
-Range("A582").Clear
-Range("B582").Clear
-Range("C582").Clear
-Range("D582").Clear
-Range("A582").Value = "xlSmartTagControlRadioGroup"
-Range("B582").Value = 14
-Range("C582").Value = num
-B582 = Range("B582").Value
-C582 = Range("C582").Value
-If B582 = C582 Then
-Range("D582").Value = "OK"
-Else
-Range("D582").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlSeparator(ByRef num)
-Range("A583").Clear
-Range("B583").Clear
-Range("C583").Clear
-Range("D583").Clear
-Range("A583").Value = "xlSmartTagControlSeparator"
-Range("B583").Value = 5
-Range("C583").Value = num
-B583 = Range("B583").Value
-C583 = Range("C583").Value
-If B583 = C583 Then
-Range("D583").Value = "OK"
-Else
-Range("D583").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlSmartTag(ByRef num)
-Range("A584").Clear
-Range("B584").Clear
-Range("C584").Clear
-Range("D584").Clear
-Range("A584").Value = "xlSmartTagControlSmartTag"
-Range("B584").Value = 1
-Range("C584").Value = num
-B584 = Range("B584").Value
-C584 = Range("C584").Value
-If B584 = C584 Then
-Range("D584").Value = "OK"
-Else
-Range("D584").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlTextbox(ByRef num)
-Range("A585").Clear
-Range("B585").Clear
-Range("C585").Clear
-Range("D585").Clear
-Range("A585").Value = "xlSmartTagControlTextbox"
-Range("B585").Value = 10
-Range("C585").Value = num
-B585 = Range("B585").Value
-C585 = Range("C585").Value
-If B585 = C585 Then
-Range("D585").Value = "OK"
-Else
-Range("D585").Value = "NG"
-End If
-End Function
-
-Function test_xlButtonOnly(ByRef num)
-Range("A586").Clear
-Range("B586").Clear
-Range("C586").Clear
-Range("D586").Clear
-Range("A586").Value = "xlButtonOnly"
-Range("B586").Value = 2
-Range("C586").Value = num
-B586 = Range("B586").Value
-C586 = Range("C586").Value
-If B586 = C586 Then
-Range("D586").Value = "OK"
-Else
-Range("D586").Value = "NG"
-End If
-End Function
-
-Function test_xlDisplayNone(ByRef num)
-Range("A587").Clear
-Range("B587").Clear
-Range("C587").Clear
-Range("D587").Clear
-Range("A587").Value = "xlDisplayNone"
-Range("B587").Value = 1
-Range("C587").Value = num
-B587 = Range("B587").Value
-C587 = Range("C587").Value
-If B587 = C587 Then
-Range("D587").Value = "OK"
-Else
-Range("D587").Value = "NG"
-End If
-End Function
-
-Function test_xlIndicatorAndButton(ByRef num)
-Range("A588").Clear
-Range("B588").Clear
-Range("C588").Clear
-Range("D588").Clear
-Range("A588").Value = "xlIndicatorAndButton"
-Range("B588").Value = 0
-Range("C588").Value = num
-B588 = Range("B588").Value
-C588 = Range("C588").Value
-If B588 = C588 Then
-Range("D588").Value = "OK"
-Else
-Range("D588").Value = "NG"
-End If
-End Function
-
-Function test_xlSortNormal(ByRef num)
-Range("A589").Clear
-Range("B589").Clear
-Range("C589").Clear
-Range("D589").Clear
-Range("A589").Value = "xlSortNormal"
-Range("B589").Value = 0
-Range("C589").Value = num
-B589 = Range("B589").Value
-C589 = Range("C589").Value
-If B589 = C589 Then
-Range("D589").Value = "OK"
-Else
-Range("D589").Value = "NG"
-End If
-End Function
-
-Function test_xlSortTextAsNumbers(ByRef num)
-Range("A590").Clear
-Range("B590").Clear
-Range("C590").Clear
-Range("D590").Clear
-Range("A590").Value = "xlSortTextAsNumbers"
-Range("B590").Value = 1
-Range("C590").Value = num
-B590 = Range("B590").Value
-C590 = Range("C590").Value
-If B590 = C590 Then
-Range("D590").Value = "OK"
-Else
-Range("D590").Value = "NG"
-End If
-End Function
-
-Function test_xlPinYin(ByRef num)
-Range("A591").Clear
-Range("B591").Clear
-Range("C591").Clear
-Range("D591").Clear
-Range("A591").Value = "xlPinYin"
-Range("B591").Value = 1
-Range("C591").Value = num
-B591 = Range("B591").Value
-C591 = Range("C591").Value
-If B591 = C591 Then
-Range("D591").Value = "OK"
-Else
-Range("D591").Value = "NG"
-End If
-End Function
-
-Function test_xlStroke(ByRef num)
-Range("A592").Clear
-Range("B592").Clear
-Range("C592").Clear
-Range("D592").Clear
-Range("A592").Value = "xlStroke"
-Range("B592").Value = 2
-Range("C592").Value = num
-B592 = Range("B592").Value
-C592 = Range("C592").Value
-If B592 = C592 Then
-Range("D592").Value = "OK"
-Else
-Range("D592").Value = "NG"
-End If
-End Function
-
-Function test_xlCodePage(ByRef num)
-Range("A593").Clear
-Range("B593").Clear
-Range("C593").Clear
-Range("D593").Clear
-Range("A593").Value = "xlCodePage"
-Range("B593").Value = 2
-Range("C593").Value = num
-B593 = Range("B593").Value
-C593 = Range("C593").Value
-If B593 = C593 Then
-Range("D593").Value = "OK"
-Else
-Range("D593").Value = "NG"
-End If
-End Function
-
-Function test_xlSyllabary(ByRef num)
-Range("A594").Clear
-Range("B594").Clear
-Range("C594").Clear
-Range("D594").Clear
-Range("A594").Value = "xlSyllabary"
-Range("B594").Value = 1
-Range("C594").Value = num
-B594 = Range("B594").Value
-C594 = Range("C594").Value
-If B594 = C594 Then
-Range("D594").Value = "OK"
-Else
-Range("D594").Value = "NG"
-End If
-End Function
-
-Function test_xlAscending(ByRef num)
-Range("A595").Clear
-Range("B595").Clear
-Range("C595").Clear
-Range("D595").Clear
-Range("A595").Value = "xlAscending"
-Range("B595").Value = 1
-Range("C595").Value = num
-B595 = Range("B595").Value
-C595 = Range("C595").Value
-If B595 = C595 Then
-Range("D595").Value = "OK"
-Else
-Range("D595").Value = "NG"
-End If
-End Function
-
-Function test_xlDescending(ByRef num)
-Range("A596").Clear
-Range("B596").Clear
-Range("C596").Clear
-Range("D596").Clear
-Range("A596").Value = "xlDescending"
-Range("B596").Value = 2
-Range("C596").Value = num
-B596 = Range("B596").Value
-C596 = Range("C596").Value
-If B596 = C596 Then
-Range("D596").Value = "OK"
-Else
-Range("D596").Value = "NG"
-End If
-End Function
-
-Function test_xlSortColumns(ByRef num)
-Range("A597").Clear
-Range("B597").Clear
-Range("C597").Clear
-Range("D597").Clear
-Range("A597").Value = "xlSortColumns"
-Range("B597").Value = 1
-Range("C597").Value = num
-B597 = Range("B597").Value
-C597 = Range("C597").Value
-If B597 = C597 Then
-Range("D597").Value = "OK"
-Else
-Range("D597").Value = "NG"
-End If
-End Function
-
-Function test_xlSortRows(ByRef num)
-Range("A598").Clear
-Range("B598").Clear
-Range("C598").Clear
-Range("D598").Clear
-Range("A598").Value = "xlSortRows"
-Range("B598").Value = 2
-Range("C598").Value = num
-B598 = Range("B598").Value
-C598 = Range("C598").Value
-If B598 = C598 Then
-Range("D598").Value = "OK"
-Else
-Range("D598").Value = "NG"
-End If
-End Function
-
-Function test_xlSortLabels(ByRef num)
-Range("A599").Clear
-Range("B599").Clear
-Range("C599").Clear
-Range("D599").Clear
-Range("A599").Value = "xlSortLabels"
-Range("B599").Value = 2
-Range("C599").Value = num
-B599 = Range("B599").Value
-C599 = Range("C599").Value
-If B599 = C599 Then
-Range("D599").Value = "OK"
-Else
-Range("D599").Value = "NG"
-End If
-End Function
-
-Function test_xlSortValues(ByRef num)
-Range("A600").Clear
-Range("B600").Clear
-Range("C600").Clear
-Range("D600").Clear
-Range("A600").Value = "xlSortValues"
-Range("B600").Value = 1
-Range("C600").Value = num
-B600 = Range("B600").Value
-C600 = Range("C600").Value
-If B600 = C600 Then
-Range("D600").Value = "OK"
-Else
-Range("D600").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceAutoFilter(ByRef num)
-Range("A601").Clear
-Range("B601").Clear
-Range("C601").Clear
-Range("D601").Clear
-Range("A601").Value = "xlSourceAutoFilter"
-Range("B601").Value = 3
-Range("C601").Value = num
-B601 = Range("B601").Value
-C601 = Range("C601").Value
-If B601 = C601 Then
-Range("D601").Value = "OK"
-Else
-Range("D601").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceChart(ByRef num)
-Range("A602").Clear
-Range("B602").Clear
-Range("C602").Clear
-Range("D602").Clear
-Range("A602").Value = "xlSourceChart"
-Range("B602").Value = 5
-Range("C602").Value = num
-B602 = Range("B602").Value
-C602 = Range("C602").Value
-If B602 = C602 Then
-Range("D602").Value = "OK"
-Else
-Range("D602").Value = "NG"
-End If
-End Function
-
-Function test_xlSourcePivotTable(ByRef num)
-Range("A603").Clear
-Range("B603").Clear
-Range("C603").Clear
-Range("D603").Clear
-Range("A603").Value = "xlSourcePivotTable"
-Range("B603").Value = 6
-Range("C603").Value = num
-B603 = Range("B603").Value
-C603 = Range("C603").Value
-If B603 = C603 Then
-Range("D603").Value = "OK"
-Else
-Range("D603").Value = "NG"
-End If
-End Function
-
-Function test_xlSourcePrintArea(ByRef num)
-Range("A604").Clear
-Range("B604").Clear
-Range("C604").Clear
-Range("D604").Clear
-Range("A604").Value = "xlSourcePrintArea"
-Range("B604").Value = 2
-Range("C604").Value = num
-B604 = Range("B604").Value
-C604 = Range("C604").Value
-If B604 = C604 Then
-Range("D604").Value = "OK"
-Else
-Range("D604").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceQuery(ByRef num)
-Range("A605").Clear
-Range("B605").Clear
-Range("C605").Clear
-Range("D605").Clear
-Range("A605").Value = "xlSourceQuery"
-Range("B605").Value = 7
-Range("C605").Value = num
-B605 = Range("B605").Value
-C605 = Range("C605").Value
-If B605 = C605 Then
-Range("D605").Value = "OK"
-Else
-Range("D605").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceRange(ByRef num)
-Range("A606").Clear
-Range("B606").Clear
-Range("C606").Clear
-Range("D606").Clear
-Range("A606").Value = "xlSourceRange"
-Range("B606").Value = 4
-Range("C606").Value = num
-B606 = Range("B606").Value
-C606 = Range("C606").Value
-If B606 = C606 Then
-Range("D606").Value = "OK"
-Else
-Range("D606").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceSheet(ByRef num)
-Range("A607").Clear
-Range("B607").Clear
-Range("C607").Clear
-Range("D607").Clear
-Range("A607").Value = "xlSourceSheet"
-Range("B607").Value = 1
-Range("C607").Value = num
-B607 = Range("B607").Value
-C607 = Range("C607").Value
-If B607 = C607 Then
-Range("D607").Value = "OK"
-Else
-Range("D607").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceWordbook(ByRef num)
-Range("A608").Clear
-Range("B608").Clear
-Range("C608").Clear
-Range("D608").Clear
-Range("A608").Value = "xlSourceWordbook"
-Range("B608").Value = 0
-Range("C608").Value = num
-B608 = Range("B608").Value
-C608 = Range("C608").Value
-If B608 = C608 Then
-Range("D608").Value = "OK"
-Else
-Range("D608").Value = "NG"
-End If
-End Function
-
-Function test_xlSpeakByColumns(ByRef num)
-Range("A609").Clear
-Range("B609").Clear
-Range("C609").Clear
-Range("D609").Clear
-Range("A609").Value = "xlSpeakByColumns"
-Range("B609").Value = 1
-Range("C609").Value = num
-B609 = Range("B609").Value
-C609 = Range("C609").Value
-If B609 = C609 Then
-Range("D609").Value = "OK"
-Else
-Range("D609").Value = "NG"
-End If
-End Function
-
-Function test_xlSpeakByRows(ByRef num)
-Range("A610").Clear
-Range("B610").Clear
-Range("C610").Clear
-Range("D610").Clear
-Range("A610").Value = "xlSpeakByRows"
-Range("B610").Value = 0
-Range("C610").Value = num
-B610 = Range("B610").Value
-C610 = Range("C610").Value
-If B610 = C610 Then
-Range("D610").Value = "OK"
-Else
-Range("D610").Value = "NG"
-End If
-End Function
-
-Function test_xlErrors(ByRef num)
-Range("A611").Clear
-Range("B611").Clear
-Range("C611").Clear
-Range("D611").Clear
-Range("A611").Value = "xlErrors"
-Range("B611").Value = 16
-Range("C611").Value = num
-B611 = Range("B611").Value
-C611 = Range("C611").Value
-If B611 = C611 Then
-Range("D611").Value = "OK"
-Else
-Range("D611").Value = "NG"
-End If
-End Function
-
-Function test_xlLogical(ByRef num)
-Range("A612").Clear
-Range("B612").Clear
-Range("C612").Clear
-Range("D612").Clear
-Range("A612").Value = "xlLogical"
-Range("B612").Value = 4
-Range("C612").Value = num
-B612 = Range("B612").Value
-C612 = Range("C612").Value
-If B612 = C612 Then
-Range("D612").Value = "OK"
-Else
-Range("D612").Value = "NG"
-End If
-End Function
-
-Function test_xlNumbers(ByRef num)
-Range("A613").Clear
-Range("B613").Clear
-Range("C613").Clear
-Range("D613").Clear
-Range("A613").Value = "xlNumbers"
-Range("B613").Value = 1
-Range("C613").Value = num
-B613 = Range("B613").Value
-C613 = Range("C613").Value
-If B613 = C613 Then
-Range("D613").Value = "OK"
-Else
-Range("D613").Value = "NG"
-End If
-End Function
-
-Function test_xlTextValues(ByRef num)
-Range("A614").Clear
-Range("B614").Clear
-Range("C614").Clear
-Range("D614").Clear
-Range("A614").Value = "xlTextValues"
-Range("B614").Value = 2
-Range("C614").Value = num
-B614 = Range("B614").Value
-C614 = Range("C614").Value
-If B614 = C614 Then
-Range("D614").Value = "OK"
-Else
-Range("D614").Value = "NG"
-End If
-End Function
-
-Function test_xlSubscribeToPicture(ByRef num)
-Range("A615").Clear
-Range("B615").Clear
-Range("C615").Clear
-Range("D615").Clear
-Range("A615").Value = "xlSubscribeToPicture"
-Range("B615").Value = -4147
-Range("C615").Value = num
-B615 = Range("B615").Value
-C615 = Range("C615").Value
-If B615 = C615 Then
-Range("D615").Value = "OK"
-Else
-Range("D615").Value = "NG"
-End If
-End Function
-
-Function test_xlSubscribeToText(ByRef num)
-Range("A616").Clear
-Range("B616").Clear
-Range("C616").Clear
-Range("D616").Clear
-Range("A616").Value = "xlSubscribeToText"
-Range("B616").Value = -4158
-Range("C616").Value = num
-B616 = Range("B616").Value
-C616 = Range("C616").Value
-If B616 = C616 Then
-Range("D616").Value = "OK"
-Else
-Range("D616").Value = "NG"
-End If
-End Function
-
-Function test_xlAtBottom(ByRef num)
-Range("A617").Clear
-Range("B617").Clear
-Range("C617").Clear
-Range("D617").Clear
-Range("A617").Value = "xlAtBottom"
-Range("B617").Value = 2
-Range("C617").Value = num
-B617 = Range("B617").Value
-C617 = Range("C617").Value
-If B617 = C617 Then
-Range("D617").Value = "OK"
-Else
-Range("D617").Value = "NG"
-End If
-End Function
-
-Function test_xlAtTop(ByRef num)
-Range("A618").Clear
-Range("B618").Clear
-Range("C618").Clear
-Range("D618").Clear
-Range("A618").Value = "xlAtTop"
-Range("B618").Value = 1
-Range("C618").Value = num
-B618 = Range("B618").Value
-C618 = Range("C618").Value
-If B618 = C618 Then
-Range("D618").Value = "OK"
-Else
-Range("D618").Value = "NG"
-End If
-End Function
-
-Function test_xlSummaryOnLeft(ByRef num)
-Range("A619").Clear
-Range("B619").Clear
-Range("C619").Clear
-Range("D619").Clear
-Range("A619").Value = "xlSummaryOnLeft"
-Range("B619").Value = -4131
-Range("C619").Value = num
-B619 = Range("B619").Value
-C619 = Range("C619").Value
-If B619 = C619 Then
-Range("D619").Value = "OK"
-Else
-Range("D619").Value = "NG"
-End If
-End Function
-
-Function test_xlSummaryOnRight(ByRef num)
-Range("A620").Clear
-Range("B620").Clear
-Range("C620").Clear
-Range("D620").Clear
-Range("A620").Value = "xlSummaryOnRight"
-Range("B620").Value = -4152
-Range("C620").Value = num
-B620 = Range("B620").Value
-C620 = Range("C620").Value
-If B620 = C620 Then
-Range("D620").Value = "OK"
-Else
-Range("D620").Value = "NG"
-End If
-End Function
-
-Function test_xlStandardSummary(ByRef num)
-Range("A621").Clear
-Range("B621").Clear
-Range("C621").Clear
-Range("D621").Clear
-Range("A621").Value = "xlStandardSummary"
-Range("B621").Value = 1
-Range("C621").Value = num
-B621 = Range("B621").Value
-C621 = Range("C621").Value
-If B621 = C621 Then
-Range("D621").Value = "OK"
-Else
-Range("D621").Value = "NG"
-End If
-End Function
-
-Function test_xlSummaryPivotTable(ByRef num)
-Range("A622").Clear
-Range("B622").Clear
-Range("C622").Clear
-Range("D622").Clear
-Range("A622").Value = "xlSummaryPivotTable"
-Range("B622").Value = -4148
-Range("C622").Value = num
-B622 = Range("B622").Value
-C622 = Range("C622").Value
-If B622 = C622 Then
-Range("D622").Value = "OK"
-Else
-Range("D622").Value = "NG"
-End If
-End Function
-
-Function test_xlSummaryAbove(ByRef num)
-Range("A623").Clear
-Range("B623").Clear
-Range("C623").Clear
-Range("D623").Clear
-Range("A623").Value = "xlSummaryAbove"
-Range("B623").Value = 0
-Range("C623").Value = num
-B623 = Range("B623").Value
-C623 = Range("C623").Value
-If B623 = C623 Then
-Range("D623").Value = "OK"
-Else
-Range("D623").Value = "NG"
-End If
-End Function
-
-Function test_xlSummaryBelow(ByRef num)
-Range("A624").Clear
-Range("B624").Clear
-Range("C624").Clear
-Range("D624").Clear
-Range("A624").Value = "xlSummaryBelow"
-Range("B624").Value = 1
-Range("C624").Value = num
-B624 = Range("B624").Value
-C624 = Range("C624").Value
-If B624 = C624 Then
-Range("D624").Value = "OK"
-Else
-Range("D624").Value = "NG"
-End If
-End Function
-
-Function test_xlTabPositionFirst(ByRef num)
-Range("A625").Clear
-Range("B625").Clear
-Range("C625").Clear
-Range("D625").Clear
-Range("A625").Value = "xlTabPositionFirst"
-Range("B625").Value = 0
-Range("C625").Value = num
-B625 = Range("B625").Value
-C625 = Range("C625").Value
-If B625 = C625 Then
-Range("D625").Value = "OK"
-Else
-Range("D625").Value = "NG"
-End If
-End Function
-
-Function test_xlTabPositionLast(ByRef num)
-Range("A626").Clear
-Range("B626").Clear
-Range("C626").Clear
-Range("D626").Clear
-Range("A626").Value = "xlTabPositionLast"
-Range("B626").Value = 1
-Range("C626").Value = num
-B626 = Range("B626").Value
-C626 = Range("C626").Value
-If B626 = C626 Then
-Range("D626").Value = "OK"
-Else
-Range("D626").Value = "NG"
-End If
-End Function
-
-Function test_xlDelimited(ByRef num)
-Range("A627").Clear
-Range("B627").Clear
-Range("C627").Clear
-Range("D627").Clear
-Range("A627").Value = "xlDelimited"
-Range("B627").Value = 1
-Range("C627").Value = num
-B627 = Range("B627").Value
-C627 = Range("C627").Value
-If B627 = C627 Then
-Range("D627").Value = "OK"
-Else
-Range("D627").Value = "NG"
-End If
-End Function
-
-Function test_xlFixedWidth(ByRef num)
-Range("A628").Clear
-Range("B628").Clear
-Range("C628").Clear
-Range("D628").Clear
-Range("A628").Value = "xlFixedWidth"
-Range("B628").Value = 2
-Range("C628").Value = num
-B628 = Range("B628").Value
-C628 = Range("C628").Value
-If B628 = C628 Then
-Range("D628").Value = "OK"
-Else
-Range("D628").Value = "NG"
-End If
-End Function
-
-Function test_xlTextQualifierDoubleQuote(ByRef num)
-Range("A629").Clear
-Range("B629").Clear
-Range("C629").Clear
-Range("D629").Clear
-Range("A629").Value = "xlTextQualifierDoubleQuote"
-Range("B629").Value = 1
-Range("C629").Value = num
-B629 = Range("B629").Value
-C629 = Range("C629").Value
-If B629 = C629 Then
-Range("D629").Value = "OK"
-Else
-Range("D629").Value = "NG"
-End If
-End Function
-
-Function test_xlTextQualifierNone(ByRef num)
-Range("A630").Clear
-Range("B630").Clear
-Range("C630").Clear
-Range("D630").Clear
-Range("A630").Value = "xlTextQualifierNone"
-Range("B630").Value = -4142
-Range("C630").Value = num
-B630 = Range("B630").Value
-C630 = Range("C630").Value
-If B630 = C630 Then
-Range("D630").Value = "OK"
-Else
-Range("D630").Value = "NG"
-End If
-End Function
-
-Function test_xlTextQualifierSingleQuote(ByRef num)
-Range("A631").Clear
-Range("B631").Clear
-Range("C631").Clear
-Range("D631").Clear
-Range("A631").Value = "xlTextQualifierSingleQuote"
-Range("B631").Value = 2
-Range("C631").Value = num
-B631 = Range("B631").Value
-C631 = Range("C631").Value
-If B631 = C631 Then
-Range("D631").Value = "OK"
-Else
-Range("D631").Value = "NG"
-End If
-End Function
-
-Function test_xlTextVisualLTR(ByRef num)
-Range("A632").Clear
-Range("B632").Clear
-Range("C632").Clear
-Range("D632").Clear
-Range("A632").Value = "xlTextVisualLTR"
-Range("B632").Value = 1
-Range("C632").Value = num
-B632 = Range("B632").Value
-C632 = Range("C632").Value
-If B632 = C632 Then
-Range("D632").Value = "OK"
-Else
-Range("D632").Value = "NG"
-End If
-End Function
-
-Function test_xlTextVisualRTL(ByRef num)
-Range("A633").Clear
-Range("B633").Clear
-Range("C633").Clear
-Range("D633").Clear
-Range("A633").Value = "xlTextVisualRTL"
-Range("B633").Value = 2
-Range("C633").Value = num
-B633 = Range("B633").Value
-C633 = Range("C633").Value
-If B633 = C633 Then
-Range("D633").Value = "OK"
-Else
-Range("D633").Value = "NG"
-End If
-End Function
-
-Function test_XlTickLabelOrientationAutomatic(ByRef num)
-Range("A634").Clear
-Range("B634").Clear
-Range("C634").Clear
-Range("D634").Clear
-Range("A634").Value = "XlTickLabelOrientationAutomatic"
-Range("B634").Value = -4105
-Range("C634").Value = num
-B634 = Range("B634").Value
-C634 = Range("C634").Value
-If B634 = C634 Then
-Range("D634").Value = "OK"
-Else
-Range("D634").Value = "NG"
-End If
-End Function
-
-Function test_XlTickLabelOrientationDownward(ByRef num)
-Range("A635").Clear
-Range("B635").Clear
-Range("C635").Clear
-Range("D635").Clear
-Range("A635").Value = "XlTickLabelOrientationDownward"
-Range("B635").Value = -4170
-Range("C635").Value = num
-B635 = Range("B635").Value
-C635 = Range("C635").Value
-If B635 = C635 Then
-Range("D635").Value = "OK"
-Else
-Range("D635").Value = "NG"
-End If
-End Function
-
-Function test_XlTickLabelOrientationHorizontal(ByRef num)
-Range("A636").Clear
-Range("B636").Clear
-Range("C636").Clear
-Range("D636").Clear
-Range("A636").Value = "XlTickLabelOrientationHorizontal"
-Range("B636").Value = -4128
-Range("C636").Value = num
-B636 = Range("B636").Value
-C636 = Range("C636").Value
-If B636 = C636 Then
-Range("D636").Value = "OK"
-Else
-Range("D636").Value = "NG"
-End If
-End Function
-
-Function test_XlTickLabelOrientationUpward(ByRef num)
-Range("A637").Clear
-Range("B637").Clear
-Range("C637").Clear
-Range("D637").Clear
-Range("A637").Value = "XlTickLabelOrientationUpward"
-Range("B637").Value = -4171
-Range("C637").Value = num
-B637 = Range("B637").Value
-C637 = Range("C637").Value
-If B637 = C637 Then
-Range("D637").Value = "OK"
-Else
-Range("D637").Value = "NG"
-End If
-End Function
-
-Function test_XlTickLabelOrientationVertical(ByRef num)
-Range("A638").Clear
-Range("B638").Clear
-Range("C638").Clear
-Range("D638").Clear
-Range("A638").Value = "XlTickLabelOrientationVertical"
-Range("B638").Value = -4166
-Range("C638").Value = num
-B638 = Range("B638").Value
-C638 = Range("C638").Value
-If B638 = C638 Then
-Range("D638").Value = "OK"
-Else
-Range("D638").Value = "NG"
-End If
-End Function
-
-Function test_xlTickLabelPositionHigh(ByRef num)
-Range("A639").Clear
-Range("B639").Clear
-Range("C639").Clear
-Range("D639").Clear
-Range("A639").Value = "xlTickLabelPositionHigh"
-Range("B639").Value = -4127
-Range("C639").Value = num
-B639 = Range("B639").Value
-C639 = Range("C639").Value
-If B639 = C639 Then
-Range("D639").Value = "OK"
-Else
-Range("D639").Value = "NG"
-End If
-End Function
-
-Function test_xlTickLabelPositionLow(ByRef num)
-Range("A640").Clear
-Range("B640").Clear
-Range("C640").Clear
-Range("D640").Clear
-Range("A640").Value = "xlTickLabelPositionLow"
-Range("B640").Value = -4134
-Range("C640").Value = num
-B640 = Range("B640").Value
-C640 = Range("C640").Value
-If B640 = C640 Then
-Range("D640").Value = "OK"
-Else
-Range("D640").Value = "NG"
-End If
-End Function
-
-Function test_xlTickLabelPositionNextToAxis(ByRef num)
-Range("A641").Clear
-Range("B641").Clear
-Range("C641").Clear
-Range("D641").Clear
-Range("A641").Value = "xlTickLabelPositionNextToAxis"
-Range("B641").Value = 4
-Range("C641").Value = num
-B641 = Range("B641").Value
-C641 = Range("C641").Value
-If B641 = C641 Then
-Range("D641").Value = "OK"
-Else
-Range("D641").Value = "NG"
-End If
-End Function
-
-Function test_xlTickLabelPositionNone(ByRef num)
-Range("A642").Clear
-Range("B642").Clear
-Range("C642").Clear
-Range("D642").Clear
-Range("A642").Value = "xlTickLabelPositionNone"
-Range("B642").Value = -4142
-Range("C642").Value = num
-B642 = Range("B642").Value
-C642 = Range("C642").Value
-If B642 = C642 Then
-Range("D642").Value = "OK"
-Else
-Range("D642").Value = "NG"
-End If
-End Function
-
-Function test_xlTickMarkCross(ByRef num)
-Range("A643").Clear
-Range("B643").Clear
-Range("C643").Clear
-Range("D643").Clear
-Range("A643").Value = "xlTickMarkCross"
-Range("B643").Value = 4
-Range("C643").Value = num
-B643 = Range("B643").Value
-C643 = Range("C643").Value
-If B643 = C643 Then
-Range("D643").Value = "OK"
-Else
-Range("D643").Value = "NG"
-End If
-End Function
-
-Function test_xlTickMarkInside(ByRef num)
-Range("A644").Clear
-Range("B644").Clear
-Range("C644").Clear
-Range("D644").Clear
-Range("A644").Value = "xlTickMarkInside"
-Range("B644").Value = 2
-Range("C644").Value = num
-B644 = Range("B644").Value
-C644 = Range("C644").Value
-If B644 = C644 Then
-Range("D644").Value = "OK"
-Else
-Range("D644").Value = "NG"
-End If
-End Function
-
-Function test_xlTickMarkNone(ByRef num)
-Range("A645").Clear
-Range("B645").Clear
-Range("C645").Clear
-Range("D645").Clear
-Range("A645").Value = "xlTickMarkNone"
-Range("B645").Value = -4142
-Range("C645").Value = num
-B645 = Range("B645").Value
-C645 = Range("C645").Value
-If B645 = C645 Then
-Range("D645").Value = "OK"
-Else
-Range("D645").Value = "NG"
-End If
-End Function
-
-Function test_xlTickMarkOutside(ByRef num)
-Range("A646").Clear
-Range("B646").Clear
-Range("C646").Clear
-Range("D646").Clear
-Range("A646").Value = "xlTickMarkOutside"
-Range("B646").Value = 3
-Range("C646").Value = num
-B646 = Range("B646").Value
-C646 = Range("C646").Value
-If B646 = C646 Then
-Range("D646").Value = "OK"
-Else
-Range("D646").Value = "NG"
-End If
-End Function
-
-Function test_xlDays(ByRef num)
-Range("A647").Clear
-Range("B647").Clear
-Range("C647").Clear
-Range("D647").Clear
-Range("A647").Value = "xlDays"
-Range("B647").Value = 0
-Range("C647").Value = num
-B647 = Range("B647").Value
-C647 = Range("C647").Value
-If B647 = C647 Then
-Range("D647").Value = "OK"
-Else
-Range("D647").Value = "NG"
-End If
-End Function
-
-Function test_xlMonths(ByRef num)
-Range("A648").Clear
-Range("B648").Clear
-Range("C648").Clear
-Range("D648").Clear
-Range("A648").Value = "xlMonths"
-Range("B648").Value = 1
-Range("C648").Value = num
-B648 = Range("B648").Value
-C648 = Range("C648").Value
-If B648 = C648 Then
-Range("D648").Value = "OK"
-Else
-Range("D648").Value = "NG"
-End If
-End Function
-
-Function test_xlYears(ByRef num)
-Range("A649").Clear
-Range("B649").Clear
-Range("C649").Clear
-Range("D649").Clear
-Range("A649").Value = "xlYears"
-Range("B649").Value = 2
-Range("C649").Value = num
-B649 = Range("B649").Value
-C649 = Range("C649").Value
-If B649 = C649 Then
-Range("D649").Value = "OK"
-Else
-Range("D649").Value = "NG"
-End If
-End Function
-
-Function test_xlNoButtonChanges(ByRef num)
-Range("A650").Clear
-Range("B650").Clear
-Range("C650").Clear
-Range("D650").Clear
-Range("A650").Value = "xlNoButtonChanges"
-Range("B650").Value = 1
-Range("C650").Value = num
-B650 = Range("B650").Value
-C650 = Range("C650").Value
-If B650 = C650 Then
-Range("D650").Value = "OK"
-Else
-Range("D650").Value = "NG"
-End If
-End Function
-
-Function test_xlNoChanges(ByRef num)
-Range("A651").Clear
-Range("B651").Clear
-Range("C651").Clear
-Range("D651").Clear
-Range("A651").Value = "xlNoChanges"
-Range("B651").Value = 4
-Range("C651").Value = num
-B651 = Range("B651").Value
-C651 = Range("C651").Value
-If B651 = C651 Then
-Range("D651").Value = "OK"
-Else
-Range("D651").Value = "NG"
-End If
-End Function
-
-Function test_xlNoDockingChanges(ByRef num)
-Range("A652").Clear
-Range("B652").Clear
-Range("C652").Clear
-Range("D652").Clear
-Range("A652").Value = "xlNoDockingChanges"
-Range("B652").Value = 3
-Range("C652").Value = num
-B652 = Range("B652").Value
-C652 = Range("C652").Value
-If B652 = C652 Then
-Range("D652").Value = "OK"
-Else
-Range("D652").Value = "NG"
-End If
-End Function
-
-Function test_xlNoShapeChanges(ByRef num)
-Range("A653").Clear
-Range("B653").Clear
-Range("C653").Clear
-Range("D653").Clear
-Range("A653").Value = "xlNoShapeChanges"
-Range("B653").Value = 2
-Range("C653").Value = num
-B653 = Range("B653").Value
-C653 = Range("C653").Value
-If B653 = C653 Then
-Range("D653").Value = "OK"
-Else
-Range("D653").Value = "NG"
-End If
-End Function
-
-Function test_xlToolbarProtectionNone(ByRef num)
-Range("A654").Clear
-Range("B654").Clear
-Range("C654").Clear
-Range("D654").Clear
-Range("A654").Value = "xlToolbarProtectionNone"
-Range("B654").Value = -4143
-Range("C654").Value = num
-B654 = Range("B654").Value
-C654 = Range("C654").Value
-If B654 = C654 Then
-Range("D654").Value = "OK"
-Else
-Range("D654").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationAverage(ByRef num)
-Range("A655").Clear
-Range("B655").Clear
-Range("C655").Clear
-Range("D655").Clear
-Range("A655").Value = "xlTotalsCalculationAverage"
-Range("B655").Value = 2
-Range("C655").Value = num
-B655 = Range("B655").Value
-C655 = Range("C655").Value
-If B655 = C655 Then
-Range("D655").Value = "OK"
-Else
-Range("D655").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCount(ByRef num)
-Range("A656").Clear
-Range("B656").Clear
-Range("C656").Clear
-Range("D656").Clear
-Range("A656").Value = "xlTotalsCalculationCount"
-Range("B656").Value = 3
-Range("C656").Value = num
-B656 = Range("B656").Value
-C656 = Range("C656").Value
-If B656 = C656 Then
-Range("D656").Value = "OK"
-Else
-Range("D656").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountNums(ByRef num)
-Range("A657").Clear
-Range("B657").Clear
-Range("C657").Clear
-Range("D657").Clear
-Range("A657").Value = "xlTotalsCalculationCountNums"
-Range("B657").Value = 4
-Range("C657").Value = num
-B657 = Range("B657").Value
-C657 = Range("C657").Value
-If B657 = C657 Then
-Range("D657").Value = "OK"
-Else
-Range("D657").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountMax(ByRef num)
-Range("A658").Clear
-Range("B658").Clear
-Range("C658").Clear
-Range("D658").Clear
-Range("A658").Value = "xlTotalsCalculationCountMax"
-Range("B658").Value = 6
-Range("C658").Value = num
-B658 = Range("B658").Value
-C658 = Range("C658").Value
-If B658 = C658 Then
-Range("D658").Value = "OK"
-Else
-Range("D658").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountMin(ByRef num)
-Range("A659").Clear
-Range("B659").Clear
-Range("C659").Clear
-Range("D659").Clear
-Range("A659").Value = "xlTotalsCalculationCountMin"
-Range("B659").Value = 5
-Range("C659").Value = num
-B659 = Range("B659").Value
-C659 = Range("C659").Value
-If B659 = C659 Then
-Range("D659").Value = "OK"
-Else
-Range("D659").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountNone(ByRef num)
-Range("A660").Clear
-Range("B660").Clear
-Range("C660").Clear
-Range("D660").Clear
-Range("A660").Value = "xlTotalsCalculationCountNone"
-Range("B660").Value = 0
-Range("C660").Value = num
-B660 = Range("B660").Value
-C660 = Range("C660").Value
-If B660 = C660 Then
-Range("D660").Value = "OK"
-Else
-Range("D660").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountStdDev(ByRef num)
-Range("A661").Clear
-Range("B661").Clear
-Range("C661").Clear
-Range("D661").Clear
-Range("A661").Value = "xlTotalsCalculationCountStdDev"
-Range("B661").Value = 7
-Range("C661").Value = num
-B661 = Range("B661").Value
-C661 = Range("C661").Value
-If B661 = C661 Then
-Range("D661").Value = "OK"
-Else
-Range("D661").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountSum(ByRef num)
-Range("A662").Clear
-Range("B662").Clear
-Range("C662").Clear
-Range("D662").Clear
-Range("A662").Value = "xlTotalsCalculationCountSum"
-Range("B662").Value = 1
-Range("C662").Value = num
-B662 = Range("B662").Value
-C662 = Range("C662").Value
-If B662 = C662 Then
-Range("D662").Value = "OK"
-Else
-Range("D662").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountVar(ByRef num)
-Range("A663").Clear
-Range("B663").Clear
-Range("C663").Clear
-Range("D663").Clear
-Range("A663").Value = "xlTotalsCalculationCountVar"
-Range("B663").Value = 8
-Range("C663").Value = num
-B663 = Range("B663").Value
-C663 = Range("C663").Value
-If B663 = C663 Then
-Range("D663").Value = "OK"
-Else
-Range("D663").Value = "NG"
-End If
-End Function
-
-Function test_xlExponential(ByRef num)
-Range("A664").Clear
-Range("B664").Clear
-Range("C664").Clear
-Range("D664").Clear
-Range("A664").Value = "xlExponential"
-Range("B664").Value = 5
-Range("C664").Value = num
-B664 = Range("B664").Value
-C664 = Range("C664").Value
-If B664 = C664 Then
-Range("D664").Value = "OK"
-Else
-Range("D664").Value = "NG"
-End If
-End Function
-
-Function test_xlLinear(ByRef num)
-Range("A665").Clear
-Range("B665").Clear
-Range("C665").Clear
-Range("D665").Clear
-Range("A665").Value = "xlLinear"
-Range("B665").Value = -4132
-Range("C665").Value = num
-B665 = Range("B665").Value
-C665 = Range("C665").Value
-If B665 = C665 Then
-Range("D665").Value = "OK"
-Else
-Range("D665").Value = "NG"
-End If
-End Function
-
-Function test_xlLogarithmic(ByRef num)
-Range("A666").Clear
-Range("B666").Clear
-Range("C666").Clear
-Range("D666").Clear
-Range("A666").Value = "xlLogarithmic"
-Range("B666").Value = -4133
-Range("C666").Value = num
-B666 = Range("B666").Value
-C666 = Range("C666").Value
-If B666 = C666 Then
-Range("D666").Value = "OK"
-Else
-Range("D666").Value = "NG"
-End If
-End Function
-
-Function test_xlMovingAvg(ByRef num)
-Range("A667").Clear
-Range("B667").Clear
-Range("C667").Clear
-Range("D667").Clear
-Range("A667").Value = "xlMovingAvg"
-Range("B667").Value = 6
-Range("C667").Value = num
-B667 = Range("B667").Value
-C667 = Range("C667").Value
-If B667 = C667 Then
-Range("D667").Value = "OK"
-Else
-Range("D667").Value = "NG"
-End If
-End Function
-
-Function test_xlPolynomial(ByRef num)
-Range("A668").Clear
-Range("B668").Clear
-Range("C668").Clear
-Range("D668").Clear
-Range("A668").Value = "xlPolynomial"
-Range("B668").Value = 3
-Range("C668").Value = num
-B668 = Range("B668").Value
-C668 = Range("C668").Value
-If B668 = C668 Then
-Range("D668").Value = "OK"
-Else
-Range("D668").Value = "NG"
-End If
-End Function
-
-Function test_xlPower(ByRef num)
-Range("A669").Clear
-Range("B669").Clear
-Range("C669").Clear
-Range("D669").Clear
-Range("A669").Value = "xlPower"
-Range("B669").Value = 4
-Range("C669").Value = num
-B669 = Range("B669").Value
-C669 = Range("C669").Value
-If B669 = C669 Then
-Range("D669").Value = "OK"
-Else
-Range("D669").Value = "NG"
-End If
-End Function
-
-Function test_XlUnderlineStyleDouble(ByRef num)
-Range("A670").Clear
-Range("B670").Clear
-Range("C670").Clear
-Range("D670").Clear
-Range("A670").Value = "XlUnderlineStyleDouble"
-Range("B670").Value = -4119
-Range("C670").Value = num
-B670 = Range("B670").Value
-C670 = Range("C670").Value
-If B670 = C670 Then
-Range("D670").Value = "OK"
-Else
-Range("D670").Value = "NG"
-End If
-End Function
-
-Function test_XlUnderlineStyleDoubleAccounting(ByRef num)
-Range("A671").Clear
-Range("B671").Clear
-Range("C671").Clear
-Range("D671").Clear
-Range("A671").Value = "XlUnderlineStyleDoubleAccounting"
-Range("B671").Value = 5
-Range("C671").Value = num
-B671 = Range("B671").Value
-C671 = Range("C671").Value
-If B671 = C671 Then
-Range("D671").Value = "OK"
-Else
-Range("D671").Value = "NG"
-End If
-End Function
-
-Function test_XlUnderlineStyleNone(ByRef num)
-Range("A672").Clear
-Range("B672").Clear
-Range("C672").Clear
-Range("D672").Clear
-Range("A672").Value = "XlUnderlineStyleNone"
-Range("B672").Value = -4142
-Range("C672").Value = num
-B672 = Range("B672").Value
-C672 = Range("C672").Value
-If B672 = C672 Then
-Range("D672").Value = "OK"
-Else
-Range("D672").Value = "NG"
-End If
-End Function
-
-Function test_XlUnderlineStyleSingle(ByRef num)
-Range("A673").Clear
-Range("B673").Clear
-Range("C673").Clear
-Range("D673").Clear
-Range("A673").Value = "XlUnderlineStyleSingle"
-Range("B673").Value = 2
-Range("C673").Value = num
-B673 = Range("B673").Value
-C673 = Range("C673").Value
-If B673 = C673 Then
-Range("D673").Value = "OK"
-Else
-Range("D673").Value = "NG"
-End If
-End Function
-
-Function test_XlUnderlineStyleSingleAccounting(ByRef num)
-Range("A674").Clear
-Range("B674").Clear
-Range("C674").Clear
-Range("D674").Clear
-Range("A674").Value = "XlUnderlineStyleSingleAccounting"
-Range("B674").Value = 4
-Range("C674").Value = num
-B674 = Range("B674").Value
-C674 = Range("C674").Value
-If B674 = C674 Then
-Range("D674").Value = "OK"
-Else
-Range("D674").Value = "NG"
-End If
-End Function
-
-Function test_XlUpdateLinksAlways(ByRef num)
-Range("A675").Clear
-Range("B675").Clear
-Range("C675").Clear
-Range("D675").Clear
-Range("A675").Value = "XlUpdateLinksAlways"
-Range("B675").Value = 3
-Range("C675").Value = num
-B675 = Range("B675").Value
-C675 = Range("C675").Value
-If B675 = C675 Then
-Range("D675").Value = "OK"
-Else
-Range("D675").Value = "NG"
-End If
-End Function
-
-Function test_XlUpdateLinksNever(ByRef num)
-Range("A676").Clear
-Range("B676").Clear
-Range("C676").Clear
-Range("D676").Clear
-Range("A676").Value = "XlUpdateLinksNever"
-Range("B676").Value = 2
-Range("C676").Value = num
-B676 = Range("B676").Value
-C676 = Range("C676").Value
-If B676 = C676 Then
-Range("D676").Value = "OK"
-Else
-Range("D676").Value = "NG"
-End If
-End Function
-
-Function test_XlUpdateLinksUserSetting(ByRef num)
-Range("A677").Clear
-Range("B677").Clear
-Range("C677").Clear
-Range("D677").Clear
-Range("A677").Value = "XlUpdateLinksUserSetting"
-Range("B677").Value = 1
-Range("C677").Value = num
-B677 = Range("B677").Value
-C677 = Range("C677").Value
-If B677 = C677 Then
-Range("D677").Value = "OK"
-Else
-Range("D677").Value = "NG"
-End If
-End Function
-
-Function test_xlVAlignBottom(ByRef num)
-Range("A678").Clear
-Range("B678").Clear
-Range("C678").Clear
-Range("D678").Clear
-Range("A678").Value = "xlVAlignBottom"
-Range("B678").Value = -4107
-Range("C678").Value = num
-B678 = Range("B678").Value
-C678 = Range("C678").Value
-If B678 = C678 Then
-Range("D678").Value = "OK"
-Else
-Range("D678").Value = "NG"
-End If
-End Function
-
-Function test_xlVAlignCenter(ByRef num)
-Range("A679").Clear
-Range("B679").Clear
-Range("C679").Clear
-Range("D679").Clear
-Range("A679").Value = "xlVAlignCenter"
-Range("B679").Value = -4108
-Range("C679").Value = num
-B679 = Range("B679").Value
-C679 = Range("C679").Value
-If B679 = C679 Then
-Range("D679").Value = "OK"
-Else
-Range("D679").Value = "NG"
-End If
-End Function
-
-Function test_xlVAlignDistributed(ByRef num)
-Range("A680").Clear
-Range("B680").Clear
-Range("C680").Clear
-Range("D680").Clear
-Range("A680").Value = "xlVAlignDistributed"
-Range("B680").Value = -4117
-Range("C680").Value = num
-B680 = Range("B680").Value
-C680 = Range("C680").Value
-If B680 = C680 Then
-Range("D680").Value = "OK"
-Else
-Range("D680").Value = "NG"
-End If
-End Function
-
-Function test_xlVAlignJustify(ByRef num)
-Range("A681").Clear
-Range("B681").Clear
-Range("C681").Clear
-Range("D681").Clear
-Range("A681").Value = "xlVAlignJustify"
-Range("B681").Value = -4130
-Range("C681").Value = num
-B681 = Range("B681").Value
-C681 = Range("C681").Value
-If B681 = C681 Then
-Range("D681").Value = "OK"
-Else
-Range("D681").Value = "NG"
-End If
-End Function
-
-Function test_xlVAlignTop(ByRef num)
-Range("A682").Clear
-Range("B682").Clear
-Range("C682").Clear
-Range("D682").Clear
-Range("A682").Value = "xlVAlignTop"
-Range("B682").Value = -4160
-Range("C682").Value = num
-B682 = Range("B682").Value
-C682 = Range("C682").Value
-If B682 = C682 Then
-Range("D682").Value = "OK"
-Else
-Range("D682").Value = "NG"
-End If
-End Function
-
-Function test_XlWBATChart(ByRef num)
-Range("A683").Clear
-Range("B683").Clear
-Range("C683").Clear
-Range("D683").Clear
-Range("A683").Value = "XlWBATChart"
-Range("B683").Value = -4109
-Range("C683").Value = num
-B683 = Range("B683").Value
-C683 = Range("C683").Value
-If B683 = C683 Then
-Range("D683").Value = "OK"
-Else
-Range("D683").Value = "NG"
-End If
-End Function
-
-Function test_XlWBATExcel4IntlMacroSheet(ByRef num)
-Range("A684").Clear
-Range("B684").Clear
-Range("C684").Clear
-Range("D684").Clear
-Range("A684").Value = "XlWBATExcel4IntlMacroSheet"
-Range("B684").Value = 4
-Range("C684").Value = num
-B684 = Range("B684").Value
-C684 = Range("C684").Value
-If B684 = C684 Then
-Range("D684").Value = "OK"
-Else
-Range("D684").Value = "NG"
-End If
-End Function
-
-Function test_XlWBATExcel4MacroSheet(ByRef num)
-Range("A685").Clear
-Range("B685").Clear
-Range("C685").Clear
-Range("D685").Clear
-Range("A685").Value = "XlWBATExcel4MacroSheet"
-Range("B685").Value = 3
-Range("C685").Value = num
-B685 = Range("B685").Value
-C685 = Range("C685").Value
-If B685 = C685 Then
-Range("D685").Value = "OK"
-Else
-Range("D685").Value = "NG"
-End If
-End Function
-
-Function test_XlWBATWorksheet(ByRef num)
-Range("A686").Clear
-Range("B686").Clear
-Range("C686").Clear
-Range("D686").Clear
-Range("A686").Value = "XlWBATWorksheet"
-Range("B686").Value = -4167
-Range("C686").Value = num
-B686 = Range("B686").Value
-C686 = Range("C686").Value
-If B686 = C686 Then
-Range("D686").Value = "OK"
-Else
-Range("D686").Value = "NG"
-End If
-End Function
-
-Function test_xlWebFormattingAll(ByRef num)
-Range("A687").Clear
-Range("B687").Clear
-Range("C687").Clear
-Range("D687").Clear
-Range("A687").Value = "xlWebFormattingAll"
-Range("B687").Value = 1
-Range("C687").Value = num
-B687 = Range("B687").Value
-C687 = Range("C687").Value
-If B687 = C687 Then
-Range("D687").Value = "OK"
-Else
-Range("D687").Value = "NG"
-End If
-End Function
-
-Function test_xlWebFormattingNone(ByRef num)
-Range("A688").Clear
-Range("B688").Clear
-Range("C688").Clear
-Range("D688").Clear
-Range("A688").Value = "xlWebFormattingNone"
-Range("B688").Value = 3
-Range("C688").Value = num
-B688 = Range("B688").Value
-C688 = Range("C688").Value
-If B688 = C688 Then
-Range("D688").Value = "OK"
-Else
-Range("D688").Value = "NG"
-End If
-End Function
-
-Function test_xlWebFormattingRTF(ByRef num)
-Range("A689").Clear
-Range("B689").Clear
-Range("C689").Clear
-Range("D689").Clear
-Range("A689").Value = "xlWebFormattingRTF"
-Range("B689").Value = 2
-Range("C689").Value = num
-B689 = Range("B689").Value
-C689 = Range("C689").Value
-If B689 = C689 Then
-Range("D689").Value = "OK"
-Else
-Range("D689").Value = "NG"
-End If
-End Function
-
-Function test_xlAllTables(ByRef num)
-Range("A690").Clear
-Range("B690").Clear
-Range("C690").Clear
-Range("D690").Clear
-Range("A690").Value = "xlAllTables"
-Range("B690").Value = 2
-Range("C690").Value = num
-B690 = Range("B690").Value
-C690 = Range("C690").Value
-If B690 = C690 Then
-Range("D690").Value = "OK"
-Else
-Range("D690").Value = "NG"
-End If
-End Function
-
-Function test_xlEntirePage(ByRef num)
-Range("A691").Clear
-Range("B691").Clear
-Range("C691").Clear
-Range("D691").Clear
-Range("A691").Value = "xlEntirePage"
-Range("B691").Value = 1
-Range("C691").Value = num
-B691 = Range("B691").Value
-C691 = Range("C691").Value
-If B691 = C691 Then
-Range("D691").Value = "OK"
-Else
-Range("D691").Value = "NG"
-End If
-End Function
-
-Function test_xlSpecifiedTables(ByRef num)
-Range("A692").Clear
-Range("B692").Clear
-Range("C692").Clear
-Range("D692").Clear
-Range("A692").Value = "xlSpecifiedTables"
-Range("B692").Value = 3
-Range("C692").Value = num
-B692 = Range("B692").Value
-C692 = Range("C692").Value
-If B692 = C692 Then
-Range("D692").Value = "OK"
-Else
-Range("D692").Value = "NG"
-End If
-End Function
-
-Function test_xlMaximized(ByRef num)
-Range("A693").Clear
-Range("B693").Clear
-Range("C693").Clear
-Range("D693").Clear
-Range("A693").Value = "xlMaximized"
-Range("B693").Value = -4137
-Range("C693").Value = num
-B693 = Range("B693").Value
-C693 = Range("C693").Value
-If B693 = C693 Then
-Range("D693").Value = "OK"
-Else
-Range("D693").Value = "NG"
-End If
-End Function
-
-Function test_xlMinimized(ByRef num)
-Range("A694").Clear
-Range("B694").Clear
-Range("C694").Clear
-Range("D694").Clear
-Range("A694").Value = "xlMinimized"
-Range("B694").Value = -4140
-Range("C694").Value = num
-B694 = Range("B694").Value
-C694 = Range("C694").Value
-If B694 = C694 Then
-Range("D694").Value = "OK"
-Else
-Range("D694").Value = "NG"
-End If
-End Function
-
-Function test_xlNormal(ByRef num)
-Range("A695").Clear
-Range("B695").Clear
-Range("C695").Clear
-Range("D695").Clear
-Range("A695").Value = "xlNormal"
-Range("B695").Value = -4143
-Range("C695").Value = num
-B695 = Range("B695").Value
-C695 = Range("C695").Value
-If B695 = C695 Then
-Range("D695").Value = "OK"
-Else
-Range("D695").Value = "NG"
-End If
-End Function
-
-Function test_xlChartAsWindow(ByRef num)
-Range("A696").Clear
-Range("B696").Clear
-Range("C696").Clear
-Range("D696").Clear
-Range("A696").Value = "xlChartAsWindow"
-Range("B696").Value = 5
-Range("C696").Value = num
-B696 = Range("B696").Value
-C696 = Range("C696").Value
-If B696 = C696 Then
-Range("D696").Value = "OK"
-Else
-Range("D696").Value = "NG"
-End If
-End Function
-
-Function test_xlChartInPlace(ByRef num)
-Range("A697").Clear
-Range("B697").Clear
-Range("C697").Clear
-Range("D697").Clear
-Range("A697").Value = "xlChartInPlace"
-Range("B697").Value = 4
-Range("C697").Value = num
-B697 = Range("B697").Value
-C697 = Range("C697").Value
-If B697 = C697 Then
-Range("D697").Value = "OK"
-Else
-Range("D697").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboard(ByRef num)
-Range("A698").Clear
-Range("B698").Clear
-Range("C698").Clear
-Range("D698").Clear
-Range("A698").Value = "xlClipboard"
-Range("B698").Value = 3
-Range("C698").Value = num
-B698 = Range("B698").Value
-C698 = Range("C698").Value
-If B698 = C698 Then
-Range("D698").Value = "OK"
-Else
-Range("D698").Value = "NG"
-End If
-End Function
-
-Function test_xlInfo(ByRef num)
-Range("A699").Clear
-Range("B699").Clear
-Range("C699").Clear
-Range("D699").Clear
-Range("A699").Value = "xlInfo"
-Range("B699").Value = -4129
-Range("C699").Value = num
-B699 = Range("B699").Value
-C699 = Range("C699").Value
-If B699 = C699 Then
-Range("D699").Value = "OK"
-Else
-Range("D699").Value = "NG"
-End If
-End Function
-
-Function test_xlWordbook(ByRef num)
-Range("A700").Clear
-Range("B700").Clear
-Range("C700").Clear
-Range("D700").Clear
-Range("A700").Value = "xlWordbook"
-Range("B700").Value = 1
-Range("C700").Value = num
-B700 = Range("B700").Value
-C700 = Range("C700").Value
-If B700 = C700 Then
-Range("D700").Value = "OK"
-Else
-Range("D700").Value = "NG"
-End If
-End Function
-
-Function test_xlNormalView(ByRef num)
-Range("A701").Clear
-Range("B701").Clear
-Range("C701").Clear
-Range("D701").Clear
-Range("A701").Value = "xlNormalView"
-Range("B701").Value = 1
-Range("C701").Value = num
-B701 = Range("B701").Value
-C701 = Range("C701").Value
-If B701 = C701 Then
-Range("D701").Value = "OK"
-Else
-Range("D701").Value = "NG"
-End If
-End Function
-
-Function test_xlPageBreakPreview(ByRef num)
-Range("A702").Clear
-Range("B702").Clear
-Range("C702").Clear
-Range("D702").Clear
-Range("A702").Value = "xlPageBreakPreview"
-Range("B702").Value = 2
-Range("C702").Value = num
-B702 = Range("B702").Value
-C702 = Range("C702").Value
-If B702 = C702 Then
-Range("D702").Value = "OK"
-Else
-Range("D702").Value = "NG"
-End If
-End Function
-
-Function test_xlCommand(ByRef num)
-Range("A703").Clear
-Range("B703").Clear
-Range("C703").Clear
-Range("D703").Clear
-Range("A703").Value = "xlCommand"
-Range("B703").Value = 2
-Range("C703").Value = num
-B703 = Range("B703").Value
-C703 = Range("C703").Value
-If B703 = C703 Then
-Range("D703").Value = "OK"
-Else
-Range("D703").Value = "NG"
-End If
-End Function
-
-Function test_xlFunction(ByRef num)
-Range("A704").Clear
-Range("B704").Clear
-Range("C704").Clear
-Range("D704").Clear
-Range("A704").Value = "xlFunction"
-Range("B704").Value = 1
-Range("C704").Value = num
-B704 = Range("B704").Value
-C704 = Range("C704").Value
-If B704 = C704 Then
-Range("D704").Value = "OK"
-Else
-Range("D704").Value = "NG"
-End If
-End Function
-
-Function test_xlnotXLM(ByRef num)
-Range("A705").Clear
-Range("B705").Clear
-Range("C705").Clear
-Range("D705").Clear
-Range("A705").Value = "xlnotXLM"
-Range("B705").Value = 3
-Range("C705").Value = num
-B705 = Range("B705").Value
-C705 = Range("C705").Value
-If B705 = C705 Then
-Range("D705").Value = "OK"
-Else
-Range("D705").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlExportSuccess(ByRef num)
-Range("A706").Clear
-Range("B706").Clear
-Range("C706").Clear
-Range("D706").Clear
-Range("A706").Value = "xlXmlExportSuccess"
-Range("B706").Value = 0
-Range("C706").Value = num
-B706 = Range("B706").Value
-C706 = Range("C706").Value
-If B706 = C706 Then
-Range("D706").Value = "OK"
-Else
-Range("D706").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlExportValidationFailed(ByRef num)
-Range("A707").Clear
-Range("B707").Clear
-Range("C707").Clear
-Range("D707").Clear
-Range("A707").Value = "xlXmlExportValidationFailed"
-Range("B707").Value = 1
-Range("C707").Value = num
-B707 = Range("B707").Value
-C707 = Range("C707").Value
-If B707 = C707 Then
-Range("D707").Value = "OK"
-Else
-Range("D707").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlImportElementsTruncated(ByRef num)
-Range("A708").Clear
-Range("B708").Clear
-Range("C708").Clear
-Range("D708").Clear
-Range("A708").Value = "xlXmlImportElementsTruncated"
-Range("B708").Value = 1
-Range("C708").Value = num
-B708 = Range("B708").Value
-C708 = Range("C708").Value
-If B708 = C708 Then
-Range("D708").Value = "OK"
-Else
-Range("D708").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlImportSuccess(ByRef num)
-Range("A709").Clear
-Range("B709").Clear
-Range("C709").Clear
-Range("D709").Clear
-Range("A709").Value = "xlXmlImportSuccess"
-Range("B709").Value = 0
-Range("C709").Value = num
-B709 = Range("B709").Value
-C709 = Range("C709").Value
-If B709 = C709 Then
-Range("D709").Value = "OK"
-Else
-Range("D709").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlImportValidationFailed(ByRef num)
-Range("A710").Clear
-Range("B710").Clear
-Range("C710").Clear
-Range("D710").Clear
-Range("A710").Value = "xlXmlImportValidationFailed"
-Range("B710").Value = 2
-Range("C710").Value = num
-B710 = Range("B710").Value
-C710 = Range("C710").Value
-If B710 = C710 Then
-Range("D710").Value = "OK"
-Else
-Range("D710").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlLoadImportToList(ByRef num)
-Range("A711").Clear
-Range("B711").Clear
-Range("C711").Clear
-Range("D711").Clear
-Range("A711").Value = "xlXmlLoadImportToList"
-Range("B711").Value = 2
-Range("C711").Value = num
-B711 = Range("B711").Value
-C711 = Range("C711").Value
-If B711 = C711 Then
-Range("D711").Value = "OK"
-Else
-Range("D711").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlLoadMapXml(ByRef num)
-Range("A712").Clear
-Range("B712").Clear
-Range("C712").Clear
-Range("D712").Clear
-Range("A712").Value = "xlXmlLoadMapXml"
-Range("B712").Value = 3
-Range("C712").Value = num
-B712 = Range("B712").Value
-C712 = Range("C712").Value
-If B712 = C712 Then
-Range("D712").Value = "OK"
-Else
-Range("D712").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlLoadOpenXml(ByRef num)
-Range("A713").Clear
-Range("B713").Clear
-Range("C713").Clear
-Range("D713").Clear
-Range("A713").Value = "xlXmlLoadOpenXml"
-Range("B713").Value = 1
-Range("C713").Value = num
-B713 = Range("B713").Value
-C713 = Range("C713").Value
-If B713 = C713 Then
-Range("D713").Value = "OK"
-Else
-Range("D713").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlLoadPromptUser(ByRef num)
-Range("A714").Clear
-Range("B714").Clear
-Range("C714").Clear
-Range("D714").Clear
-Range("A714").Value = "xlXmlLoadPromptUser"
-Range("B714").Value = 0
-Range("C714").Value = num
-B714 = Range("B714").Value
-C714 = Range("C714").Value
-If B714 = C714 Then
-Range("D714").Value = "OK"
-Else
-Range("D714").Value = "NG"
-End If
-End Function
-
-Function test_xlGuess(ByRef num)
-Range("A715").Clear
-Range("B715").Clear
-Range("C715").Clear
-Range("D715").Clear
-Range("A715").Value = "xlGuess"
-Range("B715").Value = 0
-Range("C715").Value = num
-B715 = Range("B715").Value
-C715 = Range("C715").Value
-If B715 = C715 Then
-Range("D715").Value = "OK"
-Else
-Range("D715").Value = "NG"
-End If
-End Function
-
-Function test_xlNo(ByRef num)
-Range("A716").Clear
-Range("B716").Clear
-Range("C716").Clear
-Range("D716").Clear
-Range("A716").Value = "xlNo"
-Range("B716").Value = 2
-Range("C716").Value = num
-B716 = Range("B716").Value
-C716 = Range("C716").Value
-If B716 = C716 Then
-Range("D716").Value = "OK"
-Else
-Range("D716").Value = "NG"
-End If
-End Function
-
-Function test_xlYes(ByRef num)
-Range("A717").Clear
-Range("B717").Clear
-Range("C717").Clear
-Range("D717").Clear
-Range("A717").Value = "xlYes"
-Range("B717").Value = 1
-Range("C717").Value = num
-B717 = Range("B717").Value
-C717 = Range("C717").Value
-If B717 = C717 Then
-Range("D717").Value = "OK"
-Else
-Range("D717").Value = "NG"
-End If
-End Function
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'ProjectFoo'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Simple
->>>>>>
-Attribute VB_Name = "Simple"
-Function SGetThree()
-SGetThree = 3
-End Function
-
-Function SLoop()
-Dim i As Integer
-Dim j As Integer
-j = 0
-For i = 0 To 10
-    j = j + 1
-Next i
-SLoop = j
-End Function
-
-Function SNoRetVal()
-End Function
-<<<<<<
-======================
-MoreComplex
->>>>>>
-Attribute VB_Name = "MoreComplex"
-Function MGetThree()
-MGetThree = 3
-If MGetThree = 2 Then
- MsgBox ("Hello World")
-End If
-End Function
-
-Function MLoop()
-Dim i As Integer
-Dim j As Integer
-j = 0
-For i = 0 To 10
-    j = j + 1
-Next i
-If j = 17 Then
-    MLoop = Application.Sum(Range("A1:A10"))
-End If
-MLoop = j
-End Function
-
-Function MNoRetVal()
-Dim i As Integer
-End Function
-<<<<<<
-======================
-Real
->>>>>>
-Attribute VB_Name = "Real"
-Function CtoF(Centigrade)
-  CtoF = Centigrade * 9 / 5 + 32
-End Function
-
-Function WsF(Angle)
-  WsF = WorksheetFunction.Sinh(Angle)
-End Function
-<<<<<<
-======================
-FuncVal
->>>>>>
-Attribute VB_Name = "FuncVal"
-Function MyString()
-MyString = "teststring"
-End Function
-
-Function MyDouble()
-MyDouble = 1 / 8
-End Function
-
-Function MyBoolean()
-MyBoolean = False
-End Function
-
-Function MyInt()
-MyInt = 7
-End Function
-
-Function TakeOneArg(arg1)
-TakeOneArg = arg1
-End Function
-
-Function TakeTwoArgs(arg1, arg2)
-TakeTwoArgs = arg2
-End Function
-
-Function TakeThreeArgs(arg1, arg2, arg3)
-TakeThreeArgs = arg3
-End Function
-
-Function ContainsComment()
-Rem This is a comment
-ContainsComment = 3
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-   
-    On Error Resume Next
-    Worksheets("Example4").ChartObjects.Delete
- 
-End Sub
-
-Private Sub Workbook_Open()
-    Worksheets("Change History").Activate
-    Range("VersionStart").Select
-    Selection.End(xlDown).Select
-    Selection.Copy (Worksheets("Overview").Range("VersionNumber"))
-    
-    On Error Resume Next
-    Worksheets("Example4").ChartObjects.Delete
-    
-    Worksheets("Overview").Activate
-    Range("A1").Activate
-
-End Sub
-<<<<<<
-======================
-UserForm1
->>>>>>
-Attribute VB_Name = "UserForm1"
-Attribute VB_Base = "0{DFA44B18-A9D7-11DA-9F20-0000E8226B19}{DFA44B00-A9D7-11DA-9F20-0000E8226B19}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-Dim ComboChoices()
-Private Sub CheckBox1_Click()
-
-End Sub
-
-Private Sub ComboBox1_Change()
-
-End Sub
-
-Private Sub CommandButton1_Click()
-    With UserForm1
-        .ValueOfTextBox.Value = .TextBox1.Value
-        .StateOfCheckBox.Value = .CheckBox1.Value
-        .StateOfOption1.Value = .OptionButton1.Value
-        .StateOfOption2.Value = .OptionButton2.Value
-        
-        If .ComboBox1.ListIndex > -1 Then
-            .SelectedItemComboBox.Value = ComboChoices(.ComboBox1.ListIndex)
-        Else
-            .SelectedItemComboBox.Value = "Unkown"
-        End If
-    End With
-End Sub
-
-Private Sub Label2_Click()
-
-End Sub
-
-Private Sub OptionButton1_Click()
-
-End Sub
-
-Private Sub Label3_Click()
-
-End Sub
-
-Private Sub UserForm_Click()
-
-End Sub
-
-Private Sub UserForm_Initialize()
-    ComboChoices = Array("Choice1", "Choice2", "Choice3")
-    With UserForm1.ComboBox1
-        .AddItem ComboChoices(0)
-        .AddItem ComboChoices(1)
-        .AddItem ComboChoices(2)
-    End With
-    
-    With UserForm1
-        .ValueOfTextBox.Value = ""
-        .StateOfCheckBox.Value = ""
-        .StateOfOption1.Value = ""
-        .StateOfOption2.Value = ""
-        .SelectedItemComboBox.Value = ""
-    End With
-    
-End Sub
-
-Private Sub ValueOfTextBox_Change()
-
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("WbkInformationArea").ClearContents
-    Application.Wait (Now() + TimeValue("00:00:01"))
-    Range("WbkPath").Value = ActiveWorkbook.Path
-    Range("WbkActiveWorkbook") = ActiveWorkbook.Name
-    Range("WbkActiveWorksheet") = ActiveSheet.Name
-    Range("WbkActiveCell") = ActiveCell.Address
-    Range("CurrentDateTime") = Now()
-    Range("WkShNameArea").ClearContents
-    Call ListAllWorksheets
-End Sub
-
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("WbkActiveCell") = Target.Address
-    Range("CurrentDateTime") = Now()
-End Sub
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton3Ex5, 3, 2, MSForms, CommandButton"
-
-Private Sub CommandButton3Ex5_Click()
-    Call ElementOperations
-End Sub
-
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Not (Intersect(Target, Range("MyCell")) Is Nothing) Then
-        Select Case LCase(Target.Value)
-            Case "a", "e", "i", "o", "u"
-                Range("MsgCell").Value = "vowel"
-                
-            Case "b" To "d", "f" To "h", "j" To "n", "p" To "t", "v" To "z"
-                Range("MsgCell").Value = "consonant"
-            
-            Case 0 To 9
-                Range("MsgCell").Value = "number"
-                
-            Case Else
-                Range("MsgCell").Value = "unknown"
-        End Select
-        Target.Select
-    End If
-    
-    If Not (Intersect(Target, Range("MyVector")) Is Nothing) Then
-        Range("ElementProduct").ClearContents
-        Range("ElementSum").ClearContents
-    End If
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1Ex4, 2, 0, MSForms, CommandButton"
-Private Sub CommandButton1Ex4_Click()
-    Call GenerateChart
-End Sub
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButtonEx6, 1, 0, MSForms, CommandButton"
-Private Sub CommandButtonEx6_Click()
-        MsgBox "Button Click recognized"
-End Sub
-
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton2Ex2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3Ex2, 3, 2, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton4Ex2, 5, 4, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton5Ex2, 6, 5, MSForms, CommandButton"
-Private Sub CommandButton1Ex2_Click()
-    Call getApplProperties
-End Sub
-
-Private Sub CommandButton2Ex2_Click()
-    Call generateDataToSort
-End Sub
-
-Private Sub CommandButton3Ex2_Click()
-    Call SortWithScreenUpdating
-End Sub
-
-Private Sub CommandButton4Ex2_Click()
-    Call SortWithNoScreenUpdating
-End Sub
-
-Private Sub CommandButton5Ex2_Click()
-    Call generateDataToSort
-End Sub
-
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-SampleCode
->>>>>>
-Attribute VB_Name = "SampleCode"
-'''
-''' Contains various VBA coding examples on accessing the Application Object
-'''
-Option Explicit
-
-Sub generateDataToSort()
-    Dim i As Integer
-    
-    With Range("SortArray")
-        For i = 1 To .Rows.Count
-            .Cells(i) = Int((100 * Rnd) + 1)    ' Generate random value between 1 and 100.
-        Next i
-    End With
-
-End Sub
-
-Sub SortWithScreenUpdating()
-    Application.ScreenUpdating = True
-    Call BubbleSort(Range("SortArray"))
-    Range("SortArray").Select
-    MsgBox "Sorting Completed"
-End Sub
-Sub SortWithNoScreenUpdating()
-    Application.ScreenUpdating = False
-    Call BubbleSort(Range("SortArray"))
-    Range("SortArray").Select
-    Application.ScreenUpdating = True
-    MsgBox "Sorting Completed"
-End Sub
-
-Sub BubbleSort(rngToSort As Range)
-    Dim i, j As Integer
-    Dim Temp As Variant
-
-    With rngToSort
-        For j = .Rows.Count To 1 Step -1
-            For i = 1 To j
-                .Cells(i).Interior.ColorIndex = 6
-                .Cells(j).Interior.ColorIndex = 8
-                Application.Wait (Now + TimeValue("0:00:01"))
-                If .Cells(i) > .Cells(j) Then
-                    Temp = .Cells(i)
-                    .Cells(i) = .Cells(j)
-                    .Cells(j) = Temp
-                End If
-                .Cells(i).Interior.ColorIndex = xlColorIndexNone
-                .Cells(j).Interior.ColorIndex = xlColorIndexNone
-            Next i
-        Next j
-    
-    End With
-
-End Sub
-
-Sub ElementOperations()
-    Range("ElementProduct").Value = WorksheetFunction.Sum(Range("MyVector"))
-    Range("ElementSum").Value = WorksheetFunction.Product(Range("MyVector"))
-End Sub
-
-Sub ListAllWorksheets()
-    Dim wksh As Worksheet
-    Dim i As Integer
-    
-    With Range("WkShNames")
-        i = 1
-        For Each wksh In ActiveWorkbook.Worksheets
-            .Cells(i).Value = wksh.Name
-            i = i + 1
-        Next
-    End With
-
-End Sub
-
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1Ex7, 1, 0, MSForms, CommandButton"
-Private Sub CommandButton1Ex7_Click()
-    UserForm1.Show
-End Sub
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ChartDemoCode
->>>>>>
-Attribute VB_Name = "ChartDemoCode"
-Sub GenerateChart()
-Attribute GenerateChart.VB_Description = "Macro recorded 5/14/2004 by Jim Thompson"
-Attribute GenerateChart.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro2 Macro
-' Macro recorded 5/14/2004 by Jim Thompson
-'
-
-'
-    Range("ChartData").Select
-    Charts.Add
-    ActiveChart.ChartType = xlColumnClustered
-    ActiveChart.Name = "Sample Chart"
-    ActiveChart.SetSourceData Source:=Sheets("Example4").Range("ChartData"), PlotBy:= _
-        xlColumns
-    ActiveChart.Location Where:=xlLocationAsObject, Name:="Example4"
-    With ActiveChart
-        .HasTitle = True
-        .HasLegend = False
-        .ChartTitle.Characters.Text = "Sample Chart"
-        .Axes(xlCategory, xlPrimary).HasTitle = True
-        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Category"
-        .Axes(xlValue, xlPrimary).HasTitle = True
-        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Amount"
-    End With
-    
-    Range("ChartData").Select
-End Sub
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1Ex3, 1, 0, MSForms, CommandButton"
-Private Sub CommandButton1Ex3_Click()
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Range("UpperLeftCell").Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Selection.End(xlToRight).Select
-    Range("RangeAddress") = Selection. _
-          Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Selection.End(xlDown).Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Selection.End(xlToLeft).Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Selection.End(xlUp).Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Range(Selection, Selection.End(xlToRight)).Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Range("UpperLeftCell").Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Range(Selection, Selection.End(xlDown)).Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Range("UpperLeftCell").Select
-    Range("RangeAddress") = Selection.Address
-    Application.Wait (Now + TimeValue("00:00:01"))
-    Selection.CurrentRegion.Select
-    Range("RangeAddress") = Selection.Address
-End Sub
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-test_main
-End Sub
-
-Private Sub CommandButton2_Click()
-init
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Base 1
-Dim numTests As Integer
-
-Sub init()
-numTests = 23
-reset_results
-End Sub
-Sub test_main()
-init
-On Error Resume Next ' comment out this line to help debug errors
-test1
-test2
-test3
-test4
-test5
-test6
-test7
-test8
-test9
-test10
-test11
-test12
-test13
-test14
-test15
-test16
-test17
-test18
-test19
-test20
-test21
-test22
-test23
-display_results
-End Sub
-
-
-' result for test 1 is in named range test1
-' Tests .Value property LHS assignment
-Sub test1()
-Range("B1").Value = 50
-If Range("B1").Value = 50 Then
-    Range("test1").Value = 1
-End If
-End Sub
-' result for test 2 is in named range test2
-' Tests ( default ) .Value property LHS assignment
-Sub test2()
-Range("B2") = 50
-If Range("B2").Value = 50 Then
-    Range("test2").Value = 1
-End If
-End Sub
-' result for test 3 is in named range test3
-' Tests RHS .Value property assignment
-
-Sub test3()
-Dim testVal As Integer
-testVal = 99
-Range("B3").Value = 50
-testVal = Range("B3").Value
-If testVal = 50 Then
-    Range("test3").Value = 1
-End If
-End Sub
-
-' result for test 4 is in named range test4
-' Tests RHS .Value default property assignment
-
-Sub test4()
-Dim testVal As Integer
-testVal = 99
-Range("B4").Value = 50
-testVal = Range("B4")
-If testVal = 50 Then
-    Range("test4").Value = 1
-End If
-End Sub
-' result for test 5 is in named range test5
-' Tests Range("XX") = Range("YY").Value ( lhs) default value property assignment
-' LHS is a cleared cell
-Sub test5()
-Range("B5").Value = 50
-Range("B6") = Range("B5").Value
-If Range("B6").Value = 50 Then
-    Range("test5").Value = 1
-End If
-
-End Sub
-
-' result for test 6 is in named range test6
-' Tests Range("XX").Value = Range("YY") ( rhs) default value property access
-' LHS is a cleared cell
-Sub test6()
-Range("B7").Value = 50
-Range("B8").Value = Range("B7")
-If Range("B8").Value = 50 Then
-    Range("test6").Value = 1
-End If
-End Sub
-' result for test 7 is in named range test7
-' Tests Range("XX") = Range("YY")
-' (rhs) default value property access
-' (lhs) default value property set
-' LHS is a cleared cell
-Sub test7()
-Range("B9").Value = 50
-Range("B10") = Range("B9")
-If Range("B10").Value = 50 Then
-    Range("test7").Value = 1
-End If
-End Sub
-
-' result for test 8 is in named range test8
-' Tests set objectVariable to a Range("YY") object
-Sub test8()
-Dim aRange As Object
-Range("B11") = 99
-Set aRange = Range("B11")
-If aRange.Value = 99 Then
-    Range("test8").Value = 1
-End If
-End Sub
-' result for test 9 is in named range test9
-' Tests Multiplication of a range, in Openoffice
-' val = Range("B12") * 0.1
-' this was failing due to Range("B12") getting overwritten
-' with the result of the calculation e.g. Range("B12") had 9 if
-' initial value of B12 was 90
-Sub test9()
-Range("B12").Value = 90
-Dim val As Integer
-val = 0
-val = (Range("B12") * 0.1)
-Range("B13") = val
-If Range("B13").Value = 9 And Range("B12").Value = 90 Then
-    Range("test9").Value = 1
-End If
-End Sub
-' result for test 10 is in named range test10
-' Tests multiplication of Range, there was a bug
-' in OO where "B15" in the test below would be overwritten
-' with 10
-Sub test10()
-Range("B15") = 100
-Range("B14") = (Range("B15") * 0.1)
-If Range("B14").Value = 10 And Range("B15") = 100 Then
-    Range("test10").Value = 1
-End If
-
-End Sub
-
-
-' result for test 11 is in named range test11
-' test the result of a 2-Dim range value prop
-' which should be a 2 Dim array containing the values
-' as set up in the tests below
-' e.g.
-' 1 4 7 10
-' 2 5 8 11
-' 3 6 9 12
-
-Sub test11()
-Dim testDatasc1
-Dim testDatasc2
-Dim testDatasc3
-Dim testDatasc4
-Dim cellNamesc1
-Dim cellNamesc2
-Dim cellNamesc3
-
-Dim cellName As String
-Dim cellval As Integer
-Dim colValues()
-
-testDatac1 = Array(1, 2, 3)
-testDatac2 = Array(4, 5, 6)
-testDatac3 = Array(7, 8, 9)
-testDatac4 = Array(10, 11, 12)
-
-colValues = Array(testDatac1, testDatac2, testDatac3, testDatac4)
-
-cellNamesc1 = Array("D1", "D2", "D3")
-cellNamesc2 = Array("E1", "E2", "E3")
-cellNamesc3 = Array("F1", "F2", "F3")
-cellNamesc4 = Array("G1", "G2", "G3")
-
-' set cellnames with values
-arrayset cellNamesc1, testDatac1
-arrayset cellNamesc2, testDatac2
-arrayset cellNamesc3, testDatac3
-arrayset cellNamesc4, testDatac4
-
-Dim contents As Variant
-Dim colcontents As Variant
-
-' get contents of range
-
-contents = Range("D1:G3").Value
-Dim lcol As Integer
-Dim ucol As Integer
-Dim col As Integer
-lcol = LBound(contents, 2)
-ucol = UBound(contents, 2)
-Dim res As Integer
-result = 1 ' success
-
-' check values
-For col = lcol To ucol
-
-    colcontents = getCol(contents, col)
-    For counter = LBound(colcontents) To UBound(colcontents)
-        'MsgBox " content of col " & col & " index " & counter & " has value " & colcontents(counter)
-        If checkarray(colcontents, colValues(col)) = False Then
-            result = -1
-            Exit For
-        End If
-        
-    Next counter
-Range("test11").Value = result
-Next col
-
-
-' note
-' Range("D4:G6") = Range("D1:G3") does not do a copy
-' nor does Range("D4:G6") = Range("D1:G3".Value
-' or Range("D4:G6").Value = Range("D1:G3")
-End Sub
-
-' tests a copy of a multicell range to
-' a multi cell range of the same dimensions
-
-Sub test12()
-
-Dim testDatasc1
-Dim testDatasc2
-Dim testDatasc3
-Dim testDatasc4
-Dim cellNamesc1
-Dim cellNamesc2
-Dim cellNamesc3
-
-Dim cellName As String
-Dim cellval As Integer
-Dim colValues()
-
-testDatac1 = Array(1, 2, 3)
-testDatac2 = Array(4, 5, 6)
-testDatac3 = Array(7, 8, 9)
-testDatac4 = Array(10, 11, 12)
-
-colValues = Array(testDatac1, testDatac2, testDatac3, testDatac4)
-
-cellNamesc1 = Array("D6", "D7", "D8")
-cellNamesc2 = Array("E6", "E7", "E8")
-cellNamesc3 = Array("F6", "F7", "F8")
-cellNamesc4 = Array("G6", "G7", "G8")
-' set cellnames with values
-arrayset cellNamesc1, testDatac1
-arrayset cellNamesc2, testDatac2
-arrayset cellNamesc3, testDatac3
-arrayset cellNamesc4, testDatac4
-
-Range("D9:G11").Value = Range("D6:G8").Value
-
-' Check the result of Range("D9:G11")
-Dim result As Integer
-result = 1 ' assume pass
-
-Dim origcontents
-Dim copycontents
-
-origcontents = Range("D6:G8").Value
-copycontents = Range("D9:G11").Value
-Dim lb1 As Integer
-Dim ub1 As Integer
-Dim lb2 As Integer
-Dim ub2 As Integer
-lb1 = LBound(origcontents, 1)
-ub1 = UBound(origcontents, 1)
-lb2 = LBound(origcontents, 2)
-ub2 = UBound(origcontents, 2)
-Dim i As Integer
-Dim j As Integer
-For i = lb1 To ub1
-    For j = lb2 To ub2
-        If copycontents(i, j) <> origcontents(i, j) Then
-            result = -1
-            Exit For
-        End If
-    Next j
-    If result = -1 Then
-        Exit For
-    End If
-    
-Next i
-Range("test12").Value = result
-End Sub
-
-' test setting Range.Value with 2 Dim array
-
-Sub test13()
-Dim dArray
-dArray = Range("D12:g14")
-Dim lb1 As Integer
-Dim ub1 As Integer
-Dim lb2 As Integer
-Dim ub2 As Integer
-lb1 = LBound(dArray, 1)
-ub1 = UBound(dArray, 1)
-lb2 = LBound(dArray, 2)
-ub2 = UBound(dArray, 2)
-Dim count As Integer
-For i = lb1 To ub1
-    For j = lb2 To ub2
-        dArray(i, j) = count
-        count = count + 1
-    Next j
-Next i
-Range("D12:g14").Value = dArray
-
-' get values for Range
-Dim contents
-Dim result As Integer
-result = 1
-contents = Range("D12:g14").Value
-
-' compare to values from array
-For i = lb1 To ub1
-    For j = lb2 To ub2
-        If contents(i, j) <> dArray(i, j) Then
-            result = -1
-            Exit For
-        End If
-        count = count + 1
-    Next j
-    If result = -1 Then
-        Exit For
-    End If
-Next i
-
-Range("test13").Value = result
-End Sub
-' test Range("XX").Value = number
-' the number should be applied over the range
-Sub test14()
-
-Dim contents
-Dim dValue As Integer
-dValue = 99
-Range("D16:F17").Value = dValue
-
-contents = Range("D16:F17").Value
-Dim lb1 As Integer
-Dim ub1 As Integer
-Dim lb2 As Integer
-Dim ub2 As Integer
-Dim result As Integer
-result = 1 '
-lb1 = LBound(contents, 1)
-ub1 = UBound(contents, 1)
-lb2 = LBound(contents, 2)
-ub2 = UBound(contents, 2)
-For i = lb1 To ub1
-    For j = lb2 To ub2
-        If contents(i, j) <> dValue Then
-            result = -1
-            Exit For
-        End If
-    If result = -1 Then
-        Exit For
-    End If
-    
-        
-    Next j
-Next i
-Range("test14").Value = result
-End Sub
-' test assigment of row Range to a single Array
-Sub test15()
-Dim testData()
-testData = Array(1, 2, 3, 4, 5)
-Range("A20:E20").Value = testData()
-Dim resultData()
-resultData = Range("A20:E20").Value
-Dim result As Integer
-result = 1 '
-RowIndex = LBound(resultData, 1)
-For count = LBound(resultData, 2) To UBound(resultData, 2)
-    If resultData(RowIndex, count) <> testData(count) Then
-        result = -1
-        Exit For
-    End If
-        
-    
-Next count
-Range("test15") = result
-End Sub
-
-' test assigment of col Range to a single Array
-
-Sub test16()
-Dim testData()
-testData = Array(1, 2, 3, 4, 5)
-Range("A21:A25").Value = testData()
-Dim resultData()
-resultData = Range("A21:A25").Value
-Dim result As Integer
-result = 1 '
-ColIndex = LBound(resultData, 2)
-For count = LBound(resultData, 1) To UBound(resultData, 1)
-    If resultData(count, ColIndex) <> testData(LBound(testData)) Then
-        result = -1
-        Exit For
-    End If
-        
-    
-Next count
-Range("test16") = result
-End Sub
-
-' test assigment of range to a single Array
-' to a Range of the same row size
-Sub test17()
-Dim testData()
-testData = Array(1, 2, 3, 4, 5)
-Range("A28:E29").Value = testData()
-
-Dim resultData()
-resultData = Range("A28:E29").Value
-Dim result As Integer
-result = 1 '
-
-For row = LBound(resultData, 1) To UBound(resultData, 1)
-    For col = LBound(resultData, 2) To UBound(resultData, 2)
-    'MsgBox row & "," & col & " = " & resultData(row, col)
-        If resultData(row, col) <> testData(col) Then
-            result = -1
-            Exit For
-        End If
-    Next col
-Next row
-Range("test17") = result
-End Sub
-' Test18 tests ActiveSheet.Range( Cell1, Cell2 ) method
-' results involve no offset, unlike Range.Range( Cell1, Cell2 )
-' simple range
-Sub test18()
-Dim result As Integer
-Range("c5").Select
-result = 1
-If ActiveSheet.Range(Range("a2"), Range("d5")).Address <> "$A$2:$D$5" Then
-    result = -1
-End If
-Range("test18") = result
-
-End Sub
-' Test19 tests ActiveSheet.Range( Cell1, Cell2 ) method
-' results involve no offset, unlike Range.Range( Cell1, Cell2 )
-' more complex range, the range selected is the greatest range defined
-' by overlap of Cell1 & Cell2
-Sub test19()
-Dim result As Integer
-Range("c5").Select
-result = 1
-If ActiveSheet.Range(Range("a2:d6"), Range("d5:d8")).Address <> "$A$2:$D$8" Then
-    result = -1
-End If
-Range("test19") = result
-
-End Sub
-
-Sub test20()
-Dim result As Integer
-result = 1
-If Range("c5").Range("a2").Address <> "$C$6" Then
-    result = -1
-End If
-Range("test20") = result
-End Sub
-
-
-Sub test21()
-Dim result As Integer
-result = 1
-If Range("c5:f10").Range("g4").Address <> "$I$8" Then
-    result = -1
-End If
-Range("test21") = result
-End Sub
-
-Sub test22()
-Dim result As Integer
-result = 1
-If Range("c5:c8").Range(Range("g4"), Range("l10")).Address <> "$I$8:$N$14" Then
-    result = -1
-End If
-Range("test22") = result
-End Sub
-Sub test23()
-Dim result As Integer
-result = 1
-If Range("c5:f10").Range("g4:i8").Address <> "$I$8:$K$12" Then
-    result = -1
-End If
-Range("test23") = result
-End Sub
-
-Function getCol(matrix As Variant, col As Integer) As Variant
-Dim lrow As Integer
-Dim urow As Integer
-Dim row As Integer
-lrow = LBound(matrix, 1)
-urow = UBound(matrix, 1)
-
-Dim column()
-ReDim column(urow)
-
-For row = lrow To urow
-    'column(row) = matrix(col, row)
-    Dim val As Integer
-    column(row) = matrix(row, col)
-Next row
-getCol = column()
-End Function
-Function checkarray(values As Variant, newvalues As Variant) As Boolean
-Dim count As Integer
-Dim result As Boolean
-result = True
-For count = LBound(values) To UBound(values)
-    If values(count) <> newvalues(count) Then
-        result = False
-        Exit For
-    End If
-Next count
-checkarray = result
-End Function
-Sub arrayset(names As Variant, values As Variant)
-Dim count As Integer
-Dim cellName As String
-Dim cellval As Integer
-
-For count = LBound(names) To UBound(values)
-    cellName = names(count)
-    cellval = values(count)
-    Range(cellName).Value = cellval
-Next count
-End Sub
-
-Sub reset_results()
-For count = 1 To numTests
-    Range("test" & count).Value = -1
-Next count
-' test 1
-Range("B1").Clear
-' test 2
-Range("B2").Clear
-' test 3
-Range("B3").Clear
-' test 4
-Range("B4").Clear
-' test 5
-Range("B5").Clear
-Range("B6").Clear
-' test 6
-Range("B7").Clear
-Range("B8").Clear
-' test 7
-Range("B9").Clear
-Range("B10").Clear
-' test 8
-Range("B11").Clear
-' test 9
-Range("B12").Clear
-Range("B13").Clear
-' test 10
-Range("B14").Clear
-Range("B15").Clear
-' test 11
-Range("D1:G3").Clear
-' test 12
-Range("D6:G8").Clear
-Range("D9:g11").Clear
-' test 13
-Range("D12:g14").Clear
-' test 14
-Range("D16:F17").Clear
-' test 15
-Range("A20:E20").Clear
-' test 16
-Range("A20:A25").Clear
-' test 17
-Range("A28:E29").Clear
-End Sub
-
-Sub display_results()
-Dim results As String
-Dim failed As String
-
-Dim count As Integer
-Dim testsRun As Integer
-
-For count = 1 To numTests
-    If testResult("test" & count) = False Then
-        failed = failed & "      test" & count & " failed" & Chr$(10)
-    Else
-        succeeded = succeeded + 1
-    End If
-Next count
-testsRun = count - 1
-results = results & "No. tests: " & numTests & Chr$(10)
-
-results = results & "Summary" & Chr$(10)
-results = results & "=======" & Chr$(10)
-results = results & "Run:       " & testsRun & Chr$(10)
-results = results & "Passed:    " & succeeded & Chr$(10)
-results = results & "Failed:    " & (testsRun - succeeded) & Chr$(10)
-results = results & failed
-results = results & Chr$(10) + "Expected Failure On OpenOffice: test13"
-MsgBox results
-End Sub
-
-Function testResult(arg As String) As Boolean
-If (Range(arg).Value = 1) Then
-    testResult = True
-Else
-    testResult = False
-End If
-End Function
-
-
-Sub tempStuff()
-
-' in openoffice a1 = 5, in xl its 50
-' the line below seems not do the expected in xl (?)
-Range("B1") = 50
-Range("A1").Value = (Range("B1").Value * 0.1)
-MsgBox ("A1 = " + Range("A1"))
-Range("A1") = Range("B1").Value
-Range("B2") = 100
-Range("B3") = Range("B2")
-MsgBox "B3 = " & Range("B3")
-
-val = Range("A1")
-MsgBox (Range("A1"))
-    
-'Range("A5:A8").Value =Range("A1:A4").Value
-MsgBox (val)
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub main()
-test (xlCellTypeAllFormatConditions)
-test2 (Excel.XlCellType.xlCellTypeAllValidation)
-test3 (XlCellType.xlCellTypeAllValidation)
-test4 xlCellTypeSameValidation
-End Sub
-
-Function test(ByRef num As Integer)
-MsgBox "test got " & num
-End Function
-
-Function test2(num)
-MsgBox "test2 got " & num
-End Function
-
-
-Function test3(num)
-MsgBox "test3 got " & num
-End Function
-
-Function test4(num)
-MsgBox "test4 got " & num
-End Function
-<<<<<<
-Project Name : 'VBProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-Dim NextTick
-
-Sub StartClock()
-    UpdateClock
-End Sub
-
-Sub StopClock()
-'   Cancels the OnTime event (stops the clock)
-    On Error Resume Next
-    Application.OnTime NextTick, "UpdateClock", , False
-End Sub
-
-Sub cbClockType_Click()
-'   Hides or unhids the clock
-    With ThisWorkbook.Sheets("Clock")
-        If .DrawingObjects("cbClockType").Value = xlOn Then
-            .ChartObjects("ClockChart").Visible = True
-        Else
-            .ChartObjects("ClockChart").Visible = False
-        End If
-    End With
-End Sub
-
-Sub UpdateClock()
-'   Updates the clock that's visible
-    Dim Clock As Chart
-    Set Clock = ThisWorkbook.Sheets("Clock").ChartObjects("ClockChart").Chart
-    
-    If Clock.Parent.Visible Then
-'       ANALOG CLOCK
-        Const PI As Double = 3.14159265358979
-        Dim CurrentSeries As Series
-        Dim s As Series
-        Dim x(1 To 2) As Variant
-        Dim v(1 To 2) As Variant
-    
-'       Hour hand
-        Set CurrentSeries = Clock.SeriesCollection("HourHand")
-        x(1) = 0
-        x(2) = 0.5 * Sin((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12))
-        v(1) = 0
-        v(2) = 0.5 * Cos((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12))
-        CurrentSeries.XValues = x
-        CurrentSeries.Values = v
-        
-'       Minute hand
-        Set CurrentSeries = Clock.SeriesCollection("MinuteHand")
-        x(1) = 0
-        x(2) = 0.8 * Sin((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60))
-        v(1) = 0
-        v(2) = 0.8 * Cos((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60))
-        CurrentSeries.XValues = x
-        CurrentSeries.Values = v
-    
-'       Second hand
-        Set CurrentSeries = Clock.SeriesCollection("SecondHand")
-        x(1) = 0
-        x(2) = 0.85 * Sin(Second(Time) * (2 * PI / 60))
-        v(1) = 0
-        v(2) = 0.85 * Cos(Second(Time) * (2 * PI / 60))
-        CurrentSeries.XValues = x
-        CurrentSeries.Values = v
-    Else
-'       DIGITAL CLOCK
-        ThisWorkbook.Sheets("Clock").Range("DigitalClock").Value = CDbl(Time)
-    End If
-    
-'   Set up the next event one second from now
-    NextTick = Now + TimeValue("00:00:01")
-    Application.OnTime NextTick, "UpdateClock"
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-    Call StartClock
-End Sub
-
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    Call StopClock
-End Sub
-
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-' Developed by John Walkenbach
-' of JWalk and Associates
-' http://www.j-walk.com/ss/
-' Thanks to GeeDee for suggesting the animation and colors.
-
-Dim r As Long
-
-
-
-
-Sub Scroller_Click()
-    Range("FavoriteNum").Value = " "
-End Sub
-Sub RandomButton_Click()
-    Application.ScreenUpdating = False
-    Range("a_inc").Value = Rnd() * 1000
-    Range("b_inc").Value = Rnd() * 1000
-    Range("t_inc").Value = Rnd() * 1000
-    Range("FavoriteNum").Value = ""
-    Application.ScreenUpdating = True
-End Sub
-
-Sub NextFavoriteButton_Click()
-    Application.ScreenUpdating = False
-    r = Range("FavoriteNum").Value + 1
-    If r > Application.CountA(Range("Favorites").EntireColumn) Then r = 1
-    Range("a_inc").Value = Range("Favorites").Offset(r - 1, 0).Value
-    Range("b_inc").Value = Range("Favorites").Offset(r - 1, 1).Value
-    Range("t_inc").Value = Range("Favorites").Offset(r - 1, 2).Value
-    Range("FavoriteNum").Value = r
-    Application.ScreenUpdating = True
-End Sub
-
-Sub PreviousFavoriteButton_Click()
-    Application.ScreenUpdating = False
-    r = Range("FavoriteNum").Value - 1
-    If r <= 0 Then r = Application.CountA(Range("Favorites").EntireColumn)
-    Range("a_inc").Value = Range("Favorites").Offset(r - 1, 0).Value
-    Range("b_inc").Value = Range("Favorites").Offset(r - 1, 1).Value
-    Range("t_inc").Value = Range("Favorites").Offset(r - 1, 2).Value
-    Range("FavoriteNum").Value = r
-    Application.ScreenUpdating = True
-End Sub
-
-Sub AddToFavoritesButton_Cklick()
-Attribute AddToFavoritesButton_Cklick.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim EmptyStr As String
-    EmptyStr = ""
-    
-    If Range("FavoriteNum").Value = EmptyStr Then
-        Application.ScreenUpdating = False
-        Application.Calculation = xlCalculationManual
-        r = Application.CountA(Range("Favorites").EntireColumn) + 1
-        Range("FavoriteNum").Value = r
-        Cells(r, Range("Favorites").Column) = Range("a_inc").Value
-        Cells(r, Range("Favorites").Column + 1) = Range("b_inc").Value
-        Cells(r, Range("Favorites").Column + 2) = Range("t_inc").Value
-        Application.Calculation = xlCalculationAutomatic
-        Application.ScreenUpdating = True
-    End If
-End Sub
-
-
-
-
-
-Sub InfoButton_Click()
-    ChartIsAnimated = False
-    Sheets("Info").Activate
-    Range("A2").Select
-End Sub
-
-Sub ReturnButton_Click()
-    Sheets("Chart").Activate
-    Range("E4").Select
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-    ThisWorkbook.Windows(1).WindowState = xlNormal
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If Range("CloseFlag") <> "Y" Then
-        Worksheets("Workbook Examples").Activate
-        Range("CloseFlag").Activate
-        MsgBox "CloseFlag Cell must be 'Y' to close workbook"
-        Cancel = True
-    End If
-End Sub
-
-Private Sub Workbook_Open()
-    Worksheets("Change History").Activate
-    Range("VersionStart").Select
-    Selection.End(xlDown).Select
-    Selection.Copy (Worksheets("Overview").Range("VersionNumber"))
-    Worksheets("Workbook Examples").Activate
-    Range("CloseFlag") = "N"
-    Worksheets("Overview").Activate
-    Range("A1").Activate
-
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3, 4, 2, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    Call ListAllWorksheets
-End Sub
-
-Private Sub CommandButton2_Click()
-    Call ClearWorksheetNames
-End Sub
-
-Private Sub CommandButton3_Click()
-    Call AddNewWorksheet
-End Sub
-
-Private Sub Worksheet_Activate()
-    MsgBox "This pop-up message is displayed whenever this worksheet is activated."
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3, 3, 2, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    Call SelectToFromCells
-End Sub
-
-Private Sub CommandButton2_Click()
-    Call RotateMatrix
-End Sub
-
-Private Sub CommandButton3_Click()
-    Call ElementOperations
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Not (Intersect(Target, Range("MyCell")) Is Nothing) Then
-        Select Case LCase(Target.Value)
-            Case "a", "e", "i", "o", "u"
-                Range("MsgCell").Value = "vowel"
-                
-            Case "b" To "d", "f" To "h", "j" To "n", "p" To "t", "v" To "z"
-                Range("MsgCell").Value = "consonant"
-            
-            Case 0 To 9
-                Range("MsgCell").Value = "number"
-                
-            Case Else
-                Range("MsgCell").Value = "unknown"
-        End Select
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-WorksheetsVBACode
->>>>>>
-Attribute VB_Name = "WorksheetsVBACode"
-Sub AddNewWorksheet()
-    Dim wksh As Worksheet
-    
-    Set wksh = Worksheets.Add
-    wksh.Name = "MyNewSheet"
-End Sub
-Sub ListAllWorksheets()
-    Dim wksh As Worksheet
-    Dim i As Integer
-    
-    With Range("WkShNames")
-        i = 1
-        For Each wksh In ActiveWorkbook.Worksheets
-            .Cells(i).Value = wksh.Name
-            i = i + 1
-        Next
-    End With
-
-End Sub
-
-Sub ClearWorksheetNames()
-    Dim YesNoResponse As Integer
-    
-    Range("WkShNameArea").Select
-    
-    YesNoResponse = MsgBox("Clear Worksheet Name Area?", vbYesNo)
-    
-    If YesNoResponse = vbYes Then
-        Range("WkShNameArea").ClearContents
-
-    End If
-    
-    Range("a1").Select
-End Sub
-<<<<<<
-======================
-CellVBACode
->>>>>>
-Attribute VB_Name = "CellVBACode"
-Sub SelectToFromCells()
-    Range("FromCell", "ToCell").Select
-End Sub
-
-Sub RotateMatrix()
-    Dim i As Integer, j As Integer
-    Dim Temp As Variant
-    
-    With Range("MyMatrix")
-        Temp = .Cells(2, 1)
-        .Cells(2, 1) = .Cells(2, 2)
-        .Cells(2, 2) = .Cells(1, 2)
-        .Cells(1, 2) = .Cells(1, 1)
-        .Cells(1, 1) = Temp
-    End With
-End Sub
-
-
-Sub ElementOperations()
-    Dim i As Integer
-    Dim NumberOfElements As Integer
-    Dim ElementProduct As Double
-    Dim ElementSum As Double
-    
-    With Range("MyVector")
-        NumberOfElements = .Rows.Count
-        ElementProduct = 1
-        ElementSum = 0
-        For i = 1 To NumberOfElements
-            ElementProduct = ElementProduct * .Cells(i)
-            ElementSum = ElementSum + .Cells(i)
-        Next i
-    End With
-
-    Range("ElementProduct").Value = ElementProduct
-    Range("ElementSum").Value = ElementSum
-End Sub
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3, 3, 2, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton4, 5, 4, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton5, 6, 5, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    Call getApplProperties
-End Sub
-
-Private Sub CommandButton2_Click()
-    Call generateDataToSort
-End Sub
-
-Private Sub CommandButton3_Click()
-    Call SortWithScreenUpdating
-End Sub
-
-Private Sub CommandButton4_Click()
-    Call SortWithNoScreenUpdating
-End Sub
-
-Private Sub CommandButton5_Click()
-    Call generateDataToSort
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("ApplProperties").ClearContents
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-ApplicationCode
->>>>>>
-Attribute VB_Name = "ApplicationCode"
-'''
-''' Contains various VBA coding examples on accessing the Application Object
-'''
-Option Explicit
-
-
-Sub getApplProperties()
-    Range("ApplParent") = Application.Parent
-    Range("ApplPath") = Application.Path
-    Range("ApplActiveWorkbook") = Application.ActiveWorkbook.Name
-    Range("ApplActiveSheet") = Application.ActiveSheet.Name
-    Range("ApplActiveCell") = Application.ActiveCell.Address
-    
-End Sub
-
-
-Sub generateDataToSort()
-    Dim i As Integer
-    
-    With Range("SortArray")
-        For i = 1 To .Rows.Count
-            .Cells(i) = Int((100 * Rnd) + 1)    ' Generate random value between 1 and 100.
-        Next i
-    End With
-
-End Sub
-
-Sub SortWithScreenUpdating()
-    Application.ScreenUpdating = True
-    Call BubbleSort(Range("SortArray"))
-    Range("SortArray").Select
-    MsgBox "Sorting Completed"
-End Sub
-Sub SortWithNoScreenUpdating()
-    Application.ScreenUpdating = False
-    Call BubbleSort(Range("SortArray"))
-    Range("SortArray").Select
-    Application.ScreenUpdating = True
-    MsgBox "Sorting Completed"
-End Sub
-
-Sub BubbleSort(rngToSort As Range)
-    Dim i, j As Integer
-    Dim Temp As Variant
-
-    With rngToSort
-        For j = .Rows.Count To 1 Step -1
-            For i = 1 To j
-                .Cells(i).Interior.ColorIndex = 6
-                .Cells(j).Interior.ColorIndex = 8
-                Application.Wait (Now + TimeValue("0:00:01"))
-                If .Cells(i) > .Cells(j) Then
-                    Temp = .Cells(i)
-                    .Cells(i) = .Cells(j)
-                    .Cells(j) = Temp
-                End If
-                .Cells(i).Interior.ColorIndex = xlColorIndexNone
-                .Cells(j).Interior.ColorIndex = xlColorIndexNone
-            Next i
-        Next j
-    
-    End With
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Macro1()
-Attribute Macro1.VB_Description = "Macro recorded 5/5/2004 by Jim Thompson"
-Attribute Macro1.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro1 Macro
-' Macro recorded 5/5/2004 by Jim Thompson
-'
-
-'
-    Selection.End(xlDown).Select
-End Sub
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'Controls'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-
-Private Sub CommandButton1_Click()
-ActiveSheet.Next.Select
-Rem Range("A1").Select - broken for some stupid reason
-Rem Selection.Copy
-Rem If Selection.EntireRow.Hidden = False Then
-Rem     MsgBox ("Selection Error")
-Rem End If
-ActiveSheet.Previous.Select
-End Sub
-<<<<<<
-======================
-Invocations
->>>>>>
-Attribute VB_Name = "Invocations"
-Rem       No defined return value
-
-Function INoReturnNoRet()
-End Function
-Function IGetThreeNoRet()
-IGetThreeNoRet = 3
-End Function
-Function IGetFooNoRet()
-IGetFooNoRet = "foo"
-End Function
-Function IGetPINoRet()
-IGetPINoRet = 3.1415926535898
-End Function
-
-Rem       Various return types
-
-Function IGetInteger() As Integer
-IGetInteger = 42
-End Function
-Function IGetString() As String
-IGetString = "baa"
-End Function
-Function IGetDouble() As Double
-IGetDouble = 3.1415926535898
-End Function
-Function IGetSingle() As Single
-IGetSingle = 23
-End Function
-Function IGetBoolean() As Boolean
-IGetBoolean = True
-End Function
-
-Rem       Misc parameter types
-
-Function TakesNothing()
-TakesNothing = 1
-End Function
-Function TakesInteger(arg As Integer) As Integer
-TakesInteger = 21
-End Function
-Function TakesString(arg As String) As Integer
-TakesString = 17
-End Function
-Function TakesDouble(arg As Double) As Integer
-TakesDouble = 38
-End Function
-Function TakesDate(arg As Date) As Integer
-TakesDate = 23
-End Function
-Function TakesRange(arg As Range) As Integer
-TakesRange = 11
-End Function
-
-
-Rem Optional arguments
-Function OptionalArgument(Length As Integer, Optional Width As Variant) As Integer
-If IsMissing(Width) Then
-    OptionalArgument = Length * Length
-Else
-    OptionalArgument = Length * Width
-End If
-End Function
-
-Function OptionalNonVariant(Optional IsZero As Integer) As Integer
-If IsMissing(IsZero) Then
-Rem This never occurs
-    OptionalNonVariant = 23
-Else
-    OptionalNonVariant = 17
-End If
-End Function
-
-<<<<<<
-======================
-ObjectModel
->>>>>>
-Attribute VB_Name = "ObjectModel"
-Function ObjectWorksheetFn() As Double
-ObjectWorksheetFn = WorksheetFunction.Sinh(2.3)
-End Function
-Function ObjectIsVolatile() As Double
-Application.Volatile
-ObjectIsVolatile = 3
-End Function
-Function ObjectRange(a As Range) As Integer
-ObjectRange = a.Column + a.Row + a.Height + a.Width
-End Function
-<<<<<<
-======================
-Syntax
->>>>>>
-Attribute VB_Name = "Syntax"
-Rem       Basic Statements
-Function StmtIf() As Boolean
-Dim bIf As Boolean
-bIf = True
-If bIf Then StmtIf = True
-If Not bIf Then
-    StmtIf = False
-Else
-    StmtIf = True
-End If
-End Function
-Function StmtSel() As Boolean
-Dim Digit As Integer
-Select Case Digit
-    Case 0
-        StmtSel = True
-    Case 1
-        StmtSel = False
-End Select
-End Function
-Function StmtFor() As Integer
-Dim i As Integer
-Dim j As Integer
-For i = 0 To 10
-    j = j + i
-Next i
-StmtFor = j
-End Function
-Function StmtForEach() As Integer
-Dim i(3)
-Dim j As Variant
-Dim c As Integer
-i(1) = "1"
-i(2) = Now
-i(3) = "1"
-For Each j In i()
-    c = c + 1
-Next j
-StmtForEach = c
-End Function
-Function StmtWhile() As Integer
-Dim i As Integer
-While i < 11
-    i = i + 1
-Wend
-StmtWhile = i
-End Function
-Function StmtWith() As Integer
-With Selection
-    .Orientation = 0
-End With
-StmtWith = 15
-End Function
-
-Rem       Unary Operators
-Function UnaryNot() As Boolean
-UnaryNot = Not False
-End Function
-
-Rem       Comparison Operators
-Function BinaryIsGreater() As Boolean
-BinaryIsGreater = 3 > 2
-End Function
-Function BinaryIsGreaterEqual() As Boolean
-BinaryIsGreaterEqual = 2 >= 2
-End Function
-Function BinaryIsLess() As Boolean
-BinaryIsLess = 2 < 2
-End Function
-Function BinaryIsLessEqual() As Boolean
-BinaryIsLessEqual = 4 <= 4
-End Function
-Function BinaryIsEqual() As Boolean
-BinaryIsEqual = 4 = 4
-End Function
-
-Rem       Arithmetic Operators
-Function BinaryExp() As Integer
-BinaryExp = 10 ^ 2
-End Function
-Function BinaryAdd() As Integer
-BinaryAdd = 2 + 3
-End Function
-Function BinarySub() As Integer
-BinarySub = 5 - 7
-End Function
-Function BinaryMult() As Integer
-BinaryMult = 2 * 7
-End Function
-Function BinaryDivide() As Integer
-BinaryDivide = 17 / 6
-End Function
-Function RShift() As Integer
-' RShift = 10 << 1
-End Function
-Function LShift() As Integer
-' LShift = 10 >> 1
-End Function
-
-<<<<<<
-======================
-RecordedMacros
->>>>>>
-Attribute VB_Name = "RecordedMacros"
-Sub Boldify()
-Attribute Boldify.VB_Description = "Macro recorded 20/04/2004 by Michael"
-Attribute Boldify.VB_ProcData.VB_Invoke_Func = "t\n14"
-'
-' Boldify Macro
-' Macro recorded 20/04/2004 by Michael
-'
-' Keyboard Shortcut: Ctrl+t
-'
-    Selection.Font.Bold = True
-End Sub
-Sub Italicize()
-Attribute Italicize.VB_Description = "Second Macro description"
-Attribute Italicize.VB_ProcData.VB_Invoke_Func = "J\n14"
-'
-' Italicize Macro
-' Second Macro description
-'
-' Keyboard Shortcut: Ctrl+Shift+J
-'
-    Selection.Font.Italic = True
-End Sub
-Sub Complex()
-Attribute Complex.VB_Description = "Daft thing ..."
-Attribute Complex.VB_ProcData.VB_Invoke_Func = "C\n14"
-'
-' Complex Macro
-' Daft thing ...
-'
-' Keyboard Shortcut: Ctrl+Shift+C
-'
-    ActiveCell.FormulaR1C1 = "2"
-    Range("F8").Select
-    ActiveCell.FormulaR1C1 = "3"
-    Range("F9").Select
-    Selection.Font.Bold = True
-    ActiveCell.FormulaR1C1 = "5"
-    Range("F10").Select
-    ActiveCell.FormulaR1C1 = "=R[-3]C+R[-1]C"
-    Range("F11").Select
-    With Selection.Font
-        .Name = "Arial Black"
-        .Size = 10
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveCell.FormulaR1C1 = "Arial Black"
-    Range("F12").Select
-    ActiveCell.FormulaR1C1 = "Centered"
-    Range("F13").Select
-    ActiveCell.FormulaR1C1 = "Left"
-    Range("F14").Select
-    ActiveCell.FormulaR1C1 = "Right"
-    Range("F12").Select
-    With Selection
-        .HorizontalAlignment = xlCenter
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Range("F13").Select
-    With Selection
-        .HorizontalAlignment = xlLeft
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Range("F14").Select
-    With Selection
-        .HorizontalAlignment = xlRight
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Range("F15:G15").Select
-    ActiveCell.FormulaR1C1 = "Joiined"
-    Range("F15:G15").Select
-    Range("G15").Activate
-    With Selection
-        .HorizontalAlignment = xlCenter
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Selection.Merge
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Constants
->>>>>>
-Attribute VB_Name = "Constants"
-Rem  *****  BASIC  *****
-    
-Function vbUseCompareOptionConst() As Double
-    vbUseCompareOptionConst = vbUseCompareOption
-End Function
-Function vbBinaryCompareConst() As Double
-    vbBinaryCompareConst = vbBinaryCompare
-End Function
-Function vbTextCompareConst() As Double
-    vbTextCompareConst = vbTextCompare
-End Function
-Function vbDatabaseCompareConst() As Double
-    vbDatabaseCompareConst = vbDatabaseCompare
-End Function
-Function vbSundayConst() As Double
-    vbSundayConst = vbSunday
-End Function
-Function vbMondayConst() As Double
-    vbMondayConst = vbMonday
-End Function
-Function vbTuesdayConst() As Double
-    vbTuesdayConst = vbTuesday
-End Function
-Function vbWednesdayConst() As Double
-    vbWednesdayConst = vbWednesday
-End Function
-Function vbThursdayConst() As Double
-    vbThursdayConst = vbThursday
-End Function
-Function vbFridayConst() As Double
-    vbFridayConst = vbFriday
-End Function
-Function vbSaturdayConst() As Double
-    vbSaturdayConst = vbSaturday
-End Function
-Function vbUseSystemConst() As Double
-    vbUseSystemConst = vbUseSystem
-End Function
-Function vbGeneralDateConst() As Double
-    vbGeneralDateConst = vbGeneralDate
-End Function
-Function vbLongDateConst() As Double
-    vbLongDateConst = vbLongDate
-End Function
-Function vbShortDateConst() As Double
-    vbShortDateConst = vbShortDate
-End Function
-Function vbLongTimeConst() As Double
-    vbLongTimeConst = vbLongTime
-End Function
-Function vbShortTimeConst() As Double
-    vbShortTimeConst = vbShortTime
-End Function
-Function vbObjectErrorConst() As Double
-    vbObjectErrorConst = vbObjectError
-End Function
-Function vbOKOnlyConst() As Double
-    vbOKOnlyConst = vbOKOnly
-End Function
-Function vbOKCancelConst() As Double
-    vbOKCancelConst = vbOKCancel
-End Function
-Function vbAbortRetryIgnoreConst() As Double
-    vbAbortRetryIgnoreConst = vbAbortRetryIgnore
-End Function
-Function vbYesNoCancelConst() As Double
-    vbYesNoCancelConst = vbYesNoCancel
-End Function
-Function vbYesNoConst() As Double
-    vbYesNoConst = vbYesNo
-End Function
-Function vbRetryCancelConst() As Double
-    vbRetryCancelConst = vbRetryCancel
-End Function
-Function vbCriticalConst() As Double
-    vbCriticalConst = vbCritical
-End Function
-Function vbQuestionConst() As Double
-    vbQuestionConst = vbQuestion
-End Function
-Function vbExclamationConst() As Double
-    vbExclamationConst = vbExclamation
-End Function
-Function vbInformationConst() As Double
-    vbInformationConst = vbInformation
-End Function
-Function vbDefaultButton1Const() As Double
-    vbDefaultButton1Const = vbDefaultButton1
-End Function
-Function vbDefaultButton2Const() As Double
-    vbDefaultButton2Const = vbDefaultButton2
-End Function
-Function vbDefaultButton3Const() As Double
-    vbDefaultButton3Const = vbDefaultButton3
-End Function
-Function vbDefaultButton4Const() As Double
-    vbDefaultButton4Const = vbDefaultButton4
-End Function
-Function vbApplicationModalConst() As Double
-    vbApplicationModalConst = vbApplicationModal
-End Function
-Function vbSystemModalConst() As Double
-    vbSystemModalConst = vbSystemModal
-End Function
-Function vbMsgBoxHelpButtonConst() As Double
-    vbMsgBoxHelpButtonConst = vbMsgBoxHelpButton
-End Function
-Function vbMsgBoxSetForegroundConst() As Double
-    vbMsgBoxSetForegroundConst = vbMsgBoxSetForeground
-End Function
-Function vbMsgBoxRightConst() As Double
-    vbMsgBoxRightConst = vbMsgBoxRight
-End Function
-Function vbMsgBoxRtlReadingConst() As Double
-    vbMsgBoxRtlReadingConst = vbMsgBoxRtlReading
-End Function
-
-<<<<<<
-======================
-Constants1
->>>>>>
-Attribute VB_Name = "Constants1"
-Rem  *****  BASIC  *****
-    
-Function vbCrConst() As String
-    vbCrConst = vbCr
-End Function
-Function VbCrLfConst() As String
-    VbCrLfConst = vbCrLf
-End Function
-Function vbFormFeedConst() As String
-    vbFormFeedConst = vbFormFeed
-End Function
-Function vbLfConst() As String
-    vbLfConst = vbLf
-End Function
-Function vbNewLineConst() As String
-    vbNewLineConst = vbNewLine
-End Function
-Function vbNullCharConst() As String
-    vbNullCharConst = vbNullChar
-End Function
-Function vbNullStringConst() As String
-    vbNullStringConst = vbNullString
-End Function
-Function vbTabConst() As String
-    vbTabConst = vbTab
-End Function
-Function vbVerticalTabConst() As String
-    vbVerticalTabConst = vbVerticalTab
-End Function
-Function vbUpperCaseConst() As Integer
-    vbUpperCaseConst = vbUpperCase
-End Function
-Function vbLowerCaseConst() As Integer
-    vbLowerCaseConst = vbLowerCase
-End Function
-Function vbProperCaseConst() As Integer
-    vbProperCaseConst = vbProperCase
-End Function
-Function vbWideConst() As Integer
-    vbWideConst = vbWide
-End Function
-Function vbNarrowConst() As Integer
-    vbNarrowConst = vbNarrow
-End Function
-Function vbKatakanaConst() As Integer
-    vbKatakanaConst = vbKatakana
-End Function
-Function vbHiraganaConst() As Integer
-    vbHiraganaConst = vbHiragana
-End Function
-Function vbUnicodeConst() As Integer
-    vbUnicodeConst = vbUnicode
-End Function
-Function vbFromUnicodeConst() As Integer
-    vbFromUnicodeConst = vbFromUnicode
-End Function
-Function vbUseDefaultConst() As String
-    vbUseDefaultConst = vbUseDefault
-End Function
-Function vbTrueConst() As String
-    vbTrueConst = vbTrue
-End Function
-Function vbFalseConst() As String
-    vbFalseConst = vbFalse
-End Function
-Function vbEmptyConst() As Double
-    vbEmptyConst = vbEmpty
-End Function
-Function vbNullConst() As Double
-    vbNullConst = vbNull
-End Function
-Function vbIntegerConst() As Double
-    vbIntegerConst = vbInteger
-End Function
-Function vbLongConst() As Double
-    vbLongConst = vbLong
-End Function
-Function vbSingleConst() As Double
-    vbSingleConst = vbSingle
-End Function
-Function vbDoubleConst() As Double
-    vbDoubleConst = vbDouble
-End Function
-Function vbCurrencyConst() As Double
-    vbCurrencyConst = vbCurrency
-End Function
-Function vbDateConst() As Double
-    vbDateConst = vbDate
-End Function
-Function vbStringConst() As Double
-    vbStringConst = vbString
-End Function
-Function vbObjectConst() As Double
-    vbObjectConst = vbObject
-End Function
-Function vbErrorConst() As Double
-    vbErrorConst = vbError
-End Function
-Function vbBooleanConst() As Double
-    vbBooleanConst = vbBoolean
-End Function
-Function vbVariantConst() As Double
-    vbVariantConst = vbVariant
-End Function
-Function vbDataObjectConst() As Double
-    vbDataObjectConst = vbDataObject
-End Function
-Function vbDecimalConst() As Double
-    vbDecimalConst = vbDecimal
-End Function
-Function vbByteConst() As Double
-    vbByteConst = vbByte
-End Function
-Function vbUserDefinedTypeConst() As Double
-    vbUserDefinedTypeConst = vbUserDefinedType
-End Function
-Function vbArrayConst() As Double
-    vbArrayConst = vbArray
-End Function
-
-<<<<<<
-======================
-FunctionA_E
->>>>>>
-Attribute VB_Name = "FunctionA_E"
-Rem  *****  BASIC  *****
-    
-Function rtl_abs() As Double
-    rtl_abs = Abs(-53)
-End Function
-Function rtl_array() As Variant
-    rtl_array = Array(10, 20, 30)
-End Function
-Function rtl_asc() As Integer
-    rtl_asc = Asc("A")
-End Function
-Function rtl_atn() As Double
-    rtl_atn = Atn(3.14 / 4)
-End Function
-Function rtl_callbyname()
-End Function
-Function rtl_choose()
-   rtl_choose = Choose(1, "Choose", "Error", "Error")
-End Function
-Function rtl_chr() As String
-    rtl_chr = Chr(65)
-End Function
-Function rtl_command()
-End Function
-Function rtl_cos() As Double
-    rtl_cos = Cos(0)
-End Function
-Function rtl_createobject()
-End Function
-Function rtl_curdir() As String
-    rtl_curdir = CurDir()
-End Function
-Function rtl_cverr()
-End Function
-Function rtl_date() As Date
-    rtl_date = Date
-End Function
-Function rtl_dateadd() As Double
-    Dim myDate As Date
-    myDate = "08/10/2004"
-    rtl_dateadd = DateAdd("yyyy", 1, myDate)
-End Function
-Function rtl_datediff() As Long
-    Dim myDate As Date
-    myDate = "08/10/2004"
-    rtl_datediff = DateDiff("d", "08/01/2004", myDate)
-End Function
-Function rtl_datepart() As Integer
-    Dim myDate As Date
-    myDate = "08/10/2004"
-    rtl_datepart = DatePart("q", myDate)
-End Function
-Function rtl_dateserial() As Date
-    Dim myDate As Date
-    myDate = "08/10/2004"
-    rtl_dateserial = DateSerial(2004, 8, 10)
-End Function
-Function rtl_datevalue() As Date
-    Dim myDate As Date
-    rtl_datevalue = DateValue("12/02/1969")
-End Function
-Function rtl_day() As Integer
-    Dim myDate As Date
-    myDate = "08/10/2004"
-    rtl_day = Day(myDate)
-End Function
-Function rtl_ddb() As Integer
-End Function
-Function rtl_dir() As String
-    rtl_dir = Dir(CurDir())
-End Function
-Function rtl_doevents()
-End Function
-Function rtl_environ() As String
-    rtl_environ = Environ(1)
-End Function
-Function rtl_eof()
-End Function
-Function rtl_error() As String
-    rtl_error = Error(1)
-End Function
-Function rtl_exp() As Double
-    rtl_exp = Exp(1)
-End Function
-
-<<<<<<
-======================
-FunctionF_I
->>>>>>
-Attribute VB_Name = "FunctionF_I"
-Rem  *****  BASIC  *****
-        
-Function rtl_fileattr()
-End Function
-Function rtl_filedatetime()
-End Function
-Function rtl_filelen()
-End Function
-Function rtl_filter() As String
-    Dim MyIndex() As String
-    Dim MyArray(3)
-    MyArray(0) = "Format"
-    MyArray(1) = "Filter"
-    MyArray(2) = 10
-    MyIndex() = Filter(MyArray(), "Fil")   ' MyIndex(0) contains "Monday".
-    rtl_filter = MyIndex(0)
-End Function
-Function rtl_format() As String
-    rtl_format = Format(334.9, "###0.00")   ' Returns "334.90".
-End Function
-Function rtl_formatcurrency() As String
-    rtl_formatcurrency = FormatCurrency(1000)   ' MyCurrency contains $1000.00.
-End Function
-Function rtl_FormatDateTime() As String
-    rtl_FormatDateTime = FormatDateTime("08/10/2004", vbLongDate) 'Tuesday, August 10, 2004
-End Function
-Function rtl_formatnumber() As String
-    Dim MyAngle, MySecant
-    MyAngle = 1.3   ' Define angle in radians.
-    MySecant = 1 / Cos(MyAngle)   ' Calculate secant.
-    rtl_formatnumber = FormatNumber(MySecant, 4) ' Format MySecant to four decimal places.
-End Function
-Function rtl_formatpercent() As String
-    rtl_formatpercent = FormatPercent(2 / 32) ' MyPercent contains 6.25%.
-End Function
-Function rtl_freefile()
-End Function
-Function rtl_fv()
-End Function
-Function rtl_getallsettings()
-End Function
-Function rtl_getattr()
-End Function
-Function rtl_getautoserversetting()
-End Function
-Function rtl_getobject()
-End Function
-Function rtl_getsetting()
-End Function
-Function rtl_hex() As String
-    rtl_hex = Hex(65535)
-End Function
-Function rtl_hour() As String
-    rtl_hour = Hour("12:00:00")
-End Function
-Function rtl_iif() As String
-    rtl_iif = IIf(10 > 100, "Large", "Small")
-End Function
-Function rtl_imestatus()
-End Function
-Function rtl_input()
-End Function
-Function rtl_inputbox()
-End Function
-Function rtl_instr() As Integer
-    Dim SearchString, SearchChar
-    SearchString = "XXpXXpXXPXXP"  ' String to search in.
-    SearchChar = "P"   ' Search for "P".
-        
-    ' A textual comparison starting at position 4. Returns 6.
-    rtl_instr = InStr(4, SearchString, SearchChar, 1)
-End Function
-Function rtl_instrrev() As Integer
-    Dim SearchString, SearchChar
-    SearchString = "XXpXXpXXPXXP"  ' String to search in.
-    SearchChar = "P"   ' Search for "P".
-        
-    ' returns 12
-    rtl_instrrev = InStrRev(SearchString, SearchChar)
-End Function
-Function rtl_int() As Integer
-    rtl_int = Int(7.45)
-End Function
-Function rtl_ipmt()
-End Function
-Function rtl_irr()
-End Function
-Function rtl_isarray() As Boolean
-    Dim var(3)
-    rtl_isarray = IsArray(var())
-End Function
-Function rtl_isdate() As Boolean
-    Dim var As Date
-    rtl_isdate = IsDate(var)
-End Function
-Function rtl_isempty() As Boolean
-    Dim var
-    rtl_isempty = IsEmpty(var)
-End Function
-Function rtl_iserror() As Boolean
-    Dim var As Error
-    rtl_iserror = IsError(var)
-End Function
-Function rtl_ismissing() As Boolean
-    Dim var
-    rtl_ismissing = IsMissing(var)
-End Function
-Function rtl_isnull() As Boolean
-    Dim var
-    rtl_isnull = IsNull(var)
-End Function
-Function rtl_isnumeric() As Boolean
-    Dim var As Integer
-    rtl_isnumeric = IsNumeric(var)
-End Function
-Function rtl_isobject() As Boolean
-    Dim var As Object
-    rtl_isobject = IsObject(var)
-End Function
-
-<<<<<<
-======================
-FunctionJ_R
->>>>>>
-Attribute VB_Name = "FunctionJ_R"
-Rem  *****  BASIC  *****
-        
-Function rtl_join() As String
-    Dim MyArray(3)
-    MyArray(1) = "1"
-    MyArray(2) = "1"
-    MyArray(3) = "1"
-    rtl_join = Join(MyArray())
-End Function
-Function rtl_lbound() As Integer
-    Dim MyArray(1 To 10, 5 To 15, 10 To 20)    ' Declare array variables.
-    rtl_lbound = LBound(MyArray(), 1)    ' Returns 1.
-End Function
-Function rtl_lcase() As String
-    rtl_lcase = LCase("LowerCase")
-End Function
-Function rtl_left() As String
-    rtl_left = Left("Left", 2)
-End Function
-Function rtl_len() As Long
-    rtl_len = Len("Len")
-End Function
-Function rtl_loadpicture()
-End Function
-Function rtl_loc()
-End Function
-Function rtl_lof()
-End Function
-Function rtl_log() As Double
-    rtl_log = Log(10)
-End Function
-Function rtl_ltrim() As String
-    rtl_ltrim = LTrim(" LTrim")
-End Function
-Function rtl_mid() As String
-    rtl_mid = Mid("Mid Function", 1, 3)
-End Function
-Function rtl_minute() As Integer
-    rtl_minute = Minute("12:31:45")
-End Function
-Function rtl_mirr()
-End Function
-Function rtl_month() As Integer
-    rtl_month = Month("10/08/2004")
-End Function
-Function rtl_monthname() As String
-    rtl_monthname = MonthName(10)
-End Function
-Function rtl_msgbox()
-End Function
-Function rtl_now() As Date
-    rtl_now = Now()
-End Function
-Function rtl_nper()
-End Function
-Function rtl_npv()
-End Function
-Function rtl_oct() As String
-    rtl_oct = Oct(32)
-End Function
-Function rtl_partition()
-End Function
-Function rtl_pmt()
-End Function
-Function rtl_ppmt()
-End Function
-Function rtl_pv()
-End Function
-Function rtl_qbcolor() As Long
-    rtl_qbcolor = QBColor(5)
-End Function
-Function rtl_rate()
-End Function
-Function rtl_replace() As String
-    ' A binary comparison starting at the beginning of the string.
-    rtl_replace = Replace("XXpXXPXXp", "p", "Y")
-End Function
-Function rtl_rgb() As Long
-    rtl_rgb = RGB(255, 0, 0)
-End Function
-Function rtl_right() As String
-    rtl_right = Right("right", 2)
-End Function
-Function rtl_rnd() As Single
-    rtl_rnd = Rnd(10)
-End Function
-Function rtl_round() As Single
-    rtl_round = Round(3.1415, 2)
-End Function
-
-<<<<<<
-======================
-FunctionS_Y
->>>>>>
-Attribute VB_Name = "FunctionS_Y"
-Rem  *****  BASIC  *****
-        
-Function rtl_second() As Integer
-    rtl_second = Second("12:31:45")
-End Function
-Function rtl_seek()
-End Function
-Function rtl_sgn() As Integer
-    rtl_sgn = Sgn(10)
-End Function
-Function rtl_shell() As Integer
-End Function
-Function rtl_sin() As Integer
-    rtl_sin = Sin(0)
-End Function
-Function rtl_sln()
-End Function
-Function rtl_space() As String
-    rtl_space = "4" + Space(4) + "spaces"
-End Function
-Function rtl_split()
-    rtl_split = Split("Part1 Part2 Part3")
-End Function
-Function rtl_sqr() As Double
-    rtl_sqr = Sqr(256)
-End Function
-Function rtl_str() As String
-    rtl_str = str(256)
-End Function
-Function rtl_strcomp() As Integer
-    rtl_strcomp = StrComp("strcomp", "strcomp")
-End Function
-Function rtl_strconv() As String
-    rtl_strconv = StrConv("strconv", 3)
-End Function
-Function rtl_string() As String
-    rtl_string = String(10, "s")
-End Function
-Function rtl_strreverse() As String
-    rtl_strreverse = StrReverse("reverse")
-End Function
-Function rtl_switch() As String
-    Dim str As String
-    str = "switch"
-    rtl_switch = Switch(str = "skip", "noswitch", str = "switch", "switch")
-End Function
-Function rtl_syd()
-End Function
-Function rtl_tab()
-End Function
-Function rtl_tan() As Double
-    rtl_tan = Tan(0)
-End Function
-Function rtl_time() As Date
-    rtl_time = Time()
-End Function
-Function rtl_timer() As Single
-    rtl_timer = Timer()
-End Function
-Function rtl_timeserial() As Date
-    rtl_timeserial = TimeSerial(12, 31, 45)
-End Function
-Function rtl_timevalue() As Date
-    rtl_timevalue = TimeValue("12:31:45 AM")
-End Function
-Function rtl_typename() As String
-    rtl_typename = TypeName("string")
-End Function
-Function rtl_ubound() As Integer
-    Dim MyArray(1 To 10, 5 To 15, 10 To 20)   ' Declare array variables.
-    rtl_ubound = UBound(MyArray(), 1)   ' Returns 10.
-End Function
-Function rtl_ucase() As String
-    rtl_ucase = UCase("Uppercase")
-End Function
-Function rtl_val() As Integer
-    rtl_val = Val("3.1415")
-End Function
-Function rtl_vartype() As Integer
-    rtl_vartype = VarType(10)
-End Function
-Function rtl_weekday() As Integer
-    rtl_weekday = Weekday("10/08/2004")
-End Function
-Function rtl_weekdayname() As String
-    rtl_weekdayname = WeekdayName(6)
-End Function
-Function rtl_year() As String
-    rtl_year = Year("10/08/2004")
-End Function
-
-<<<<<<
-Project Name : 'Animated Chart Example.xls'
-Quirk - duff tag length======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "ScrollBar1, 4, 1, MSForms, ScrollBar"
-Attribute VB_Control = "CommandButton1, 5, 2, MSForms, CommandButton"
-
-
-Private Sub CommandButton1_Click()
-Range("A1").Value = 0
-End Sub
-
-Private Sub ScrollBar1_Change()
-    Range("A1").Value = Range("B1").Value * 0.035
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    MsgBox "Hello your workbook name is " & Application.ActiveWorkbook.Name
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CheckBox1, 1, 0, MSForms, CheckBox"
-Attribute VB_Control = "CheckBox2, 2, 1, MSForms, CheckBox"
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "OptionButton1, 2, 1, MSForms, OptionButton"
-Attribute VB_Control = "OptionButton2, 3, 2, MSForms, OptionButton"
-Attribute VB_Control = "OptionButton3, 4, 3, MSForms, OptionButton"
-Private Sub OptionButton1_Click()
-    'blue
-    Cells.Interior.Color = RGB(0, 0, 255)
-End Sub
-
-Private Sub OptionButton2_Click()
-    'green
-    Cells.Interior.Color = RGB(0, 255, 0)
-End Sub
-
-Private Sub OptionButton3_Click()
-    'red
-    Cells.Interior.Color = RGB(255, 0, 0)
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "TextBox1, 1, 0, MSForms, TextBox"
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "ListBox1, 1, 0, MSForms, ListBox"
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "ComboBox1, 1, 0, MSForms, ComboBox"
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "ScrollBar1, 1, 0, MSForms, ScrollBar"
-Attribute VB_Control = "ScrollBar2, 2, 1, MSForms, ScrollBar"
-Attribute VB_Control = "ScrollBar3, 3, 2, MSForms, ScrollBar"
-Private Sub ScrollBar1_Change()
-    Call UpdateColor
-End Sub
-
-Private Sub ScrollBar2_Change()
-    Call UpdateColor
-End Sub
-
-Private Sub ScrollBar3_Change()
-    Call UpdateColor
-End Sub
-
-Private Sub UpdateColor()
-    Cells.Interior.Color = RGB(Range("A1"), Range("A2"), Range("A3"))
-End Sub
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "SpinButton1, 1, 0, MSForms, SpinButton"
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Private Sub Workbook_Open()
-
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "SpinButton1, 2, 0, MSForms, SpinButton"
-Attribute VB_Control = "Reset, 3, 1, MSForms, CommandButton"
-Private Sub Reset_Click()
-
-Application.ScreenUpdating = False
-
-ActiveSheet.Range("direction").Cells(1, 1).Value = 1
-ActiveSheet.Range("direction").Cells(1, 2).Value = 0
-Dim center_x As Long
-Dim center_y As Long
-With ActiveSheet.Range("board")
-    .Clear
-    .Interior.Color = RGB(0, 0, 0)
-    center_x = .Column + .Columns.Count / 2
-    center_y = .Row + .Rows.Count / 2
-End With
-With ActiveSheet.Range("position")
-    Dim pos As Long
-    For pos = 1 To .Rows.Count
-        .Cells(pos, 1).Value = center_x
-        .Cells(pos, 2).Value = center_y
-    Next pos
-    pos = .Rows.Count
-    .Cells(pos, 1).Value = center_x - 1
-    .Cells(pos, 2).Value = center_y - 1
-End With
-
-Application.ScreenUpdating = True
-
-End Sub
-
-'Sub DrawSnake(sheet As Worksheet, pos As Range)
-Sub DrawSnake(sheet As Object, pos As Object)
-Dim col As Long
-For idx = 1 To pos.Rows.Count
-    x = pos.Cells(idx, 1).Value
-    y = pos.Cells(idx, 2).Value
-    If idx = pos.Rows.Count Then
-        col = RGB(0, 0, 0)
-    Else
-        col = RGB(150, 0, 0)
-    End If
-'    MsgBox ("Set " + Str(x) + " " + Str(y) + " to " + Str(col))
-    sheet.Cells(y, x).Interior.Color = col
-'    sheet.Range("A1:IV65536").Cells(y, x).Value = col
-Next idx
-End Sub
-
-Sub MoveSnake(board As Object, ByRef x As Long, ByRef y As Long, ByRef dir_x As Long, ByRef dir_y As Long)
-
-x = x + dir_x
-y = y + dir_y
-
-' New wrapping code
-x = ((x - board.Column + board.Columns.Count) Mod board.Columns.Count) + board.Column
-y = ((y - board.Row + board.Rows.Count) Mod board.Rows.Count) + board.Row
-
-' should we change direction ? - bias for X due to non-square foos
-If (dir_x = 0 And Rnd() > 0.75) Or _
-   (dir_x <> 0 And Rnd() > 0.85) Then
-    ' Swap dirx & diry & randomly negate
-    Dim tmp As Long
-    tmp = dir_x
-    dir_x = dir_y
-    dir_y = tmp
-    If Rnd() > 0.5 Then
-        dir_x = -dir_x
-        dir_y = -dir_y
-    End If
-End If
-
-End Sub
-Private Sub SpinButton1_Change()
-
-Application.ScreenUpdating = False
-
-Dim sheet As Object
-Set sheet = ActiveSheet
-
-Dim x As Long
-Dim y As Long
-Dim dir_x As Long
-Dim dir_y As Long
-
-x = sheet.Range("position").Cells(1, 1).Value
-y = sheet.Range("position").Cells(1, 2).Value
-dir_x = sheet.Range("direction").Cells(1, 1).Value
-dir_y = sheet.Range("direction").Cells(1, 2).Value
-
-'Dim board As Range
-Dim board As Object
-Set board = sheet.Range("board")
-
-Call MoveSnake(board, x, y, dir_x, dir_y)
-
-'MsgBox ("Moved to " + Str(x) + " " + Str(y) + " to red")
-
-sheet.Range("position").Cells(1, 1).Value = x
-sheet.Range("position").Cells(1, 2).Value = y
-ActiveSheet.Range("direction").Cells(1, 1).Value = dir_x
-ActiveSheet.Range("direction").Cells(1, 2).Value = dir_y
-
-Call DrawSnake(sheet, sheet.Range("position"))
-
-sheet.Range("src").Copy (sheet.Range("dest"))
-
-Application.ScreenUpdating = True
-
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub doSnake()
-
-Dim pos As Integer
-Dim sheet As Object
-
-Set sheet = Application.Workbooks(1).Sheets(1)
-For pos = 1 To 20
-Rem  With sheet.Cells(1, b).Interior
-    sheet.Cells(1, pos).Interior.Color = RGB(123, 0, 0)
-Rem    End With
-Rem Application.Wait (Now + TimeValue("00:00:01"))
-Next pos
-
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub test()
-Sheets("sheet1").Activate
-main_1
-Sheets("sheet2").Activate
-main_2
-Sheets("sheet3").Activate
-main_3
-Sheets("sheet4").Activate
-main_4
-Sheets("sheet5").Activate
-main_5
-End Sub
-Sub main_1()
-test_xl24HourClock (xl24HourClock)
-test_xl4DigitYears (xl4DigitYears)
-test_xlAlternateArraySeparator (xlAlternateArraySeparator)
-test_xlColumnSeparator (xlColumnSeparator)
-test_xlCountryCode (xlCountryCode)
-test_xlCountrySetting (xlCountrySetting)
-test_xlCurrencyBefore (xlCurrencyBefore)
-test_xlCurrencyCode (xlCurrencyCode)
-test_xlCurrencyDigits (xlCurrencyDigits)
-test_xlCurrencyLeadingZeros (xlCurrencyLeadingZeros)
-test_xlCurrencyMinusSign (xlCurrencyMinusSign)
-test_xlCurrencyNegative (xlCurrencyNegative)
-test_xlCurrencySpaceBefore (xlCurrencySpaceBefore)
-test_xlCurrencyTrailingZeros (xlCurrencyTrailingZeros)
-test_xlDateOrder (xlDateOrder)
-test_xlDateSeparator (xlDateSeparator)
-test_xlDayCode (xlDayCode)
-test_xlDayLeadingZero (xlDayLeadingZero)
-test_xlDecimalSeparator (xlDecimalSeparator)
-test_xlGeneralFormatName (xlGeneralFormatName)
-test_xlHourCode (xlHourCode)
-test_xlLeftBrace (xlLeftBrace)
-test_xlLeftBracket (xlLeftBracket)
-test_xlListSeparator (xlListSeparator)
-test_xlLowerCaseColumnLetter (xlLowerCaseColumnLetter)
-test_xlLowerCaseRowLetter (xlLowerCaseRowLetter)
-test_xlMDY (xlMDY)
-test_xlMetric (xlMetric)
-test_xlMinuteCode (xlMinuteCode)
-test_xlMonthCode (xlMonthCode)
-test_xlMonthLeadingZero (xlMonthLeadingZero)
-test_xlMonthNameChars (xlMonthNameChars)
-test_xlNocurrencyDigits (xlNocurrencyDigits)
-test_xlNonEnglishFunctions (xlNonEnglishFunctions)
-test_xlRightBrace (xlRightBrace)
-test_xlRightBracket (xlRightBracket)
-test_xlRowSeparator (xlRowSeparator)
-test_xlSecondCode (xlSecondCode)
-test_xlThousandsSeparator (xlThousandsSeparator)
-test_xlTimeLeadingZero (xlTimeLeadingZero)
-test_xlTimeSeparator (xlTimeSeparator)
-test_xlUpperCaseColumnLetter (xlUpperCaseColumnLetter)
-test_xlUpperCaseRowLetter (xlUpperCaseRowLetter)
-test_xlWeekdayNameChars (xlWeekdayNameChars)
-test_xlYearCode (xlYearCode)
-test_xlColumnThenRow (xlColumnThenRow)
-test_xlRowThenColumn (xlRowThenColumn)
-test_xlArabicBothStrict (xlArabicBothStrict)
-test_xlArabicNone (xlArabicNone)
-test_xlArabicStrictAlefHamza (xlArabicStrictAlefHamza)
-test_xlArabicStrictFinalYaa (xlArabicStrictFinalYaa)
-test_xlArrangeStyleCascade (xlArrangeStyleCascade)
-test_xlArrangeStyleHorizontal (xlArrangeStyleHorizontal)
-test_xlArrangeStyleTiled (xlArrangeStyleTiled)
-test_xlArrangeStyleVertical (xlArrangeStyleVertical)
-test_xlArrowHeadLengthLong (xlArrowHeadLengthLong)
-test_xlArrowHeadLengthMedium (xlArrowHeadLengthMedium)
-test_xlArrowHeadLengthShort (xlArrowHeadLengthShort)
-test_xlArrowHeadStyleClosed (xlArrowHeadStyleClosed)
-test_xlArrowHeadStyleDoubleClosed (xlArrowHeadStyleDoubleClosed)
-test_xlArrowHeadStyleDoubleOpen (xlArrowHeadStyleDoubleOpen)
-test_xlArrowHeadStyleNone (xlArrowHeadStyleNone)
-test_xlArrowHeadStyleOpen (xlArrowHeadStyleOpen)
-test_xlArrowHeadWidthMedium (xlArrowHeadWidthMedium)
-test_xlArrowHeadWidthNarrow (xlArrowHeadWidthNarrow)
-test_xlArrowHeadWidthWide (xlArrowHeadWidthWide)
-test_xlFillCopy (xlFillCopy)
-test_xlFillDays (xlFillDays)
-test_xlFillDefault (xlFillDefault)
-test_xlFillFormats (xlFillFormats)
-test_xlFillMonths (xlFillMonths)
-test_xlFillSeries (xlFillSeries)
-test_xlFillValues (xlFillValues)
-test_xlFillWeekdays (xlFillWeekdays)
-test_xlFillYears (xlFillYears)
-test_xlGrowthTrend (xlGrowthTrend)
-test_xlLinearTrend (xlLinearTrend)
-test_xlAnd (xlAnd)
-test_xlBottom10Items (xlBottom10Items)
-test_xlBottom10Percent (xlBottom10Percent)
-test_xlOr (xlOr)
-test_xlTop10Items (xlTop10Items)
-test_xlTop10Percent (xlTop10Percent)
-test_xlAxisCrossesAutomatic (xlAxisCrossesAutomatic)
-test_xlAxisCrossesCustom (xlAxisCrossesCustom)
-test_xlAxisCrossesMaximum (xlAxisCrossesMaximum)
-test_xlAxisCrossesMinimum (xlAxisCrossesMinimum)
-test_xlPrimary (xlPrimary)
-test_xlSecondary (xlSecondary)
-test_xlCategory (xlCategory)
-test_xlSeriesAxis (xlSeriesAxis)
-test_xlValue (xlValue)
-Range("A1").Value = "constant name"
-Range("B1").Value = "OOo result"
-Range("C1").Value = "Excel result"
-Range("D1").Value = "Correct?"
-End Sub
-
-Function test_xl24HourClock(ByRef num)
-Range("A2").Clear
-Range("B2").Clear
-Range("C2").Clear
-Range("D2").Clear
-Range("A2").Value = "xl24HourClock"
-Range("B2").Value = 33
-Range("C2").Value = num
-B2 = Range("B2").Value
-C2 = Range("C2").Value
-If B2 = C2 Then
-Range("D2").Value = "OK"
-Else
-Range("D2").Value = "NG"
-End If
-End Function
-
-Function test_xl4DigitYears(ByRef num)
-Range("A3").Clear
-Range("B3").Clear
-Range("C3").Clear
-Range("D3").Clear
-Range("A3").Value = "xl4DigitYears"
-Range("B3").Value = 43
-Range("C3").Value = num
-B3 = Range("B3").Value
-C3 = Range("C3").Value
-If B3 = C3 Then
-Range("D3").Value = "OK"
-Else
-Range("D3").Value = "NG"
-End If
-End Function
-
-Function test_xlAlternateArraySeparator(ByRef num)
-Range("A4").Clear
-Range("B4").Clear
-Range("C4").Clear
-Range("D4").Clear
-Range("A4").Value = "xlAlternateArraySeparator"
-Range("B4").Value = 16
-Range("C4").Value = num
-B4 = Range("B4").Value
-C4 = Range("C4").Value
-If B4 = C4 Then
-Range("D4").Value = "OK"
-Else
-Range("D4").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnSeparator(ByRef num)
-Range("A5").Clear
-Range("B5").Clear
-Range("C5").Clear
-Range("D5").Clear
-Range("A5").Value = "xlColumnSeparator"
-Range("B5").Value = 14
-Range("C5").Value = num
-B5 = Range("B5").Value
-C5 = Range("C5").Value
-If B5 = C5 Then
-Range("D5").Value = "OK"
-Else
-Range("D5").Value = "NG"
-End If
-End Function
-
-Function test_xlCountryCode(ByRef num)
-Range("A6").Clear
-Range("B6").Clear
-Range("C6").Clear
-Range("D6").Clear
-Range("A6").Value = "xlCountryCode"
-Range("B6").Value = 1
-Range("C6").Value = num
-B6 = Range("B6").Value
-C6 = Range("C6").Value
-If B6 = C6 Then
-Range("D6").Value = "OK"
-Else
-Range("D6").Value = "NG"
-End If
-End Function
-
-Function test_xlCountrySetting(ByRef num)
-Range("A7").Clear
-Range("B7").Clear
-Range("C7").Clear
-Range("D7").Clear
-Range("A7").Value = "xlCountrySetting"
-Range("B7").Value = 2
-Range("C7").Value = num
-B7 = Range("B7").Value
-C7 = Range("C7").Value
-If B7 = C7 Then
-Range("D7").Value = "OK"
-Else
-Range("D7").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyBefore(ByRef num)
-Range("A8").Clear
-Range("B8").Clear
-Range("C8").Clear
-Range("D8").Clear
-Range("A8").Value = "xlCurrencyBefore"
-Range("B8").Value = 37
-Range("C8").Value = num
-B8 = Range("B8").Value
-C8 = Range("C8").Value
-If B8 = C8 Then
-Range("D8").Value = "OK"
-Else
-Range("D8").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyCode(ByRef num)
-Range("A9").Clear
-Range("B9").Clear
-Range("C9").Clear
-Range("D9").Clear
-Range("A9").Value = "xlCurrencyCode"
-Range("B9").Value = 25
-Range("C9").Value = num
-B9 = Range("B9").Value
-C9 = Range("C9").Value
-If B9 = C9 Then
-Range("D9").Value = "OK"
-Else
-Range("D9").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyDigits(ByRef num)
-Range("A10").Clear
-Range("B10").Clear
-Range("C10").Clear
-Range("D10").Clear
-Range("A10").Value = "xlCurrencyDigits"
-Range("B10").Value = 27
-Range("C10").Value = num
-B10 = Range("B10").Value
-C10 = Range("C10").Value
-If B10 = C10 Then
-Range("D10").Value = "OK"
-Else
-Range("D10").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyLeadingZeros(ByRef num)
-Range("A11").Clear
-Range("B11").Clear
-Range("C11").Clear
-Range("D11").Clear
-Range("A11").Value = "xlCurrencyLeadingZeros"
-Range("B11").Value = 40
-Range("C11").Value = num
-B11 = Range("B11").Value
-C11 = Range("C11").Value
-If B11 = C11 Then
-Range("D11").Value = "OK"
-Else
-Range("D11").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyMinusSign(ByRef num)
-Range("A12").Clear
-Range("B12").Clear
-Range("C12").Clear
-Range("D12").Clear
-Range("A12").Value = "xlCurrencyMinusSign"
-Range("B12").Value = 38
-Range("C12").Value = num
-B12 = Range("B12").Value
-C12 = Range("C12").Value
-If B12 = C12 Then
-Range("D12").Value = "OK"
-Else
-Range("D12").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyNegative(ByRef num)
-Range("A13").Clear
-Range("B13").Clear
-Range("C13").Clear
-Range("D13").Clear
-Range("A13").Value = "xlCurrencyNegative"
-Range("B13").Value = 28
-Range("C13").Value = num
-B13 = Range("B13").Value
-C13 = Range("C13").Value
-If B13 = C13 Then
-Range("D13").Value = "OK"
-Else
-Range("D13").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencySpaceBefore(ByRef num)
-Range("A14").Clear
-Range("B14").Clear
-Range("C14").Clear
-Range("D14").Clear
-Range("A14").Value = "xlCurrencySpaceBefore"
-Range("B14").Value = 36
-Range("C14").Value = num
-B14 = Range("B14").Value
-C14 = Range("C14").Value
-If B14 = C14 Then
-Range("D14").Value = "OK"
-Else
-Range("D14").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrencyTrailingZeros(ByRef num)
-Range("A15").Clear
-Range("B15").Clear
-Range("C15").Clear
-Range("D15").Clear
-Range("A15").Value = "xlCurrencyTrailingZeros"
-Range("B15").Value = 39
-Range("C15").Value = num
-B15 = Range("B15").Value
-C15 = Range("C15").Value
-If B15 = C15 Then
-Range("D15").Value = "OK"
-Else
-Range("D15").Value = "NG"
-End If
-End Function
-
-Function test_xlDateOrder(ByRef num)
-Range("A16").Clear
-Range("B16").Clear
-Range("C16").Clear
-Range("D16").Clear
-Range("A16").Value = "xlDateOrder"
-Range("B16").Value = 32
-Range("C16").Value = num
-B16 = Range("B16").Value
-C16 = Range("C16").Value
-If B16 = C16 Then
-Range("D16").Value = "OK"
-Else
-Range("D16").Value = "NG"
-End If
-End Function
-
-Function test_xlDateSeparator(ByRef num)
-Range("A17").Clear
-Range("B17").Clear
-Range("C17").Clear
-Range("D17").Clear
-Range("A17").Value = "xlDateSeparator"
-Range("B17").Value = 17
-Range("C17").Value = num
-B17 = Range("B17").Value
-C17 = Range("C17").Value
-If B17 = C17 Then
-Range("D17").Value = "OK"
-Else
-Range("D17").Value = "NG"
-End If
-End Function
-
-Function test_xlDayCode(ByRef num)
-Range("A18").Clear
-Range("B18").Clear
-Range("C18").Clear
-Range("D18").Clear
-Range("A18").Value = "xlDayCode"
-Range("B18").Value = 21
-Range("C18").Value = num
-B18 = Range("B18").Value
-C18 = Range("C18").Value
-If B18 = C18 Then
-Range("D18").Value = "OK"
-Else
-Range("D18").Value = "NG"
-End If
-End Function
-
-Function test_xlDayLeadingZero(ByRef num)
-Range("A19").Clear
-Range("B19").Clear
-Range("C19").Clear
-Range("D19").Clear
-Range("A19").Value = "xlDayLeadingZero"
-Range("B19").Value = 42
-Range("C19").Value = num
-B19 = Range("B19").Value
-C19 = Range("C19").Value
-If B19 = C19 Then
-Range("D19").Value = "OK"
-Else
-Range("D19").Value = "NG"
-End If
-End Function
-
-Function test_xlDecimalSeparator(ByRef num)
-Range("A20").Clear
-Range("B20").Clear
-Range("C20").Clear
-Range("D20").Clear
-Range("A20").Value = "xlDecimalSeparator"
-Range("B20").Value = 3
-Range("C20").Value = num
-B20 = Range("B20").Value
-C20 = Range("C20").Value
-If B20 = C20 Then
-Range("D20").Value = "OK"
-Else
-Range("D20").Value = "NG"
-End If
-End Function
-
-Function test_xlGeneralFormatName(ByRef num)
-Range("A21").Clear
-Range("B21").Clear
-Range("C21").Clear
-Range("D21").Clear
-Range("A21").Value = "xlGeneralFormatName"
-Range("B21").Value = 26
-Range("C21").Value = num
-B21 = Range("B21").Value
-C21 = Range("C21").Value
-If B21 = C21 Then
-Range("D21").Value = "OK"
-Else
-Range("D21").Value = "NG"
-End If
-End Function
-
-Function test_xlHourCode(ByRef num)
-Range("A22").Clear
-Range("B22").Clear
-Range("C22").Clear
-Range("D22").Clear
-Range("A22").Value = "xlHourCode"
-Range("B22").Value = 22
-Range("C22").Value = num
-B22 = Range("B22").Value
-C22 = Range("C22").Value
-If B22 = C22 Then
-Range("D22").Value = "OK"
-Else
-Range("D22").Value = "NG"
-End If
-End Function
-
-Function test_xlLeftBrace(ByRef num)
-Range("A23").Clear
-Range("B23").Clear
-Range("C23").Clear
-Range("D23").Clear
-Range("A23").Value = "xlLeftBrace"
-Range("B23").Value = 12
-Range("C23").Value = num
-B23 = Range("B23").Value
-C23 = Range("C23").Value
-If B23 = C23 Then
-Range("D23").Value = "OK"
-Else
-Range("D23").Value = "NG"
-End If
-End Function
-
-Function test_xlLeftBracket(ByRef num)
-Range("A24").Clear
-Range("B24").Clear
-Range("C24").Clear
-Range("D24").Clear
-Range("A24").Value = "xlLeftBracket"
-Range("B24").Value = 10
-Range("C24").Value = num
-B24 = Range("B24").Value
-C24 = Range("C24").Value
-If B24 = C24 Then
-Range("D24").Value = "OK"
-Else
-Range("D24").Value = "NG"
-End If
-End Function
-
-Function test_xlListSeparator(ByRef num)
-Range("A25").Clear
-Range("B25").Clear
-Range("C25").Clear
-Range("D25").Clear
-Range("A25").Value = "xlListSeparator"
-Range("B25").Value = 5
-Range("C25").Value = num
-B25 = Range("B25").Value
-C25 = Range("C25").Value
-If B25 = C25 Then
-Range("D25").Value = "OK"
-Else
-Range("D25").Value = "NG"
-End If
-End Function
-
-Function test_xlLowerCaseColumnLetter(ByRef num)
-Range("A26").Clear
-Range("B26").Clear
-Range("C26").Clear
-Range("D26").Clear
-Range("A26").Value = "xlLowerCaseColumnLetter"
-Range("B26").Value = 9
-Range("C26").Value = num
-B26 = Range("B26").Value
-C26 = Range("C26").Value
-If B26 = C26 Then
-Range("D26").Value = "OK"
-Else
-Range("D26").Value = "NG"
-End If
-End Function
-
-Function test_xlLowerCaseRowLetter(ByRef num)
-Range("A27").Clear
-Range("B27").Clear
-Range("C27").Clear
-Range("D27").Clear
-Range("A27").Value = "xlLowerCaseRowLetter"
-Range("B27").Value = 8
-Range("C27").Value = num
-B27 = Range("B27").Value
-C27 = Range("C27").Value
-If B27 = C27 Then
-Range("D27").Value = "OK"
-Else
-Range("D27").Value = "NG"
-End If
-End Function
-
-Function test_xlMDY(ByRef num)
-Range("A28").Clear
-Range("B28").Clear
-Range("C28").Clear
-Range("D28").Clear
-Range("A28").Value = "xlMDY"
-Range("B28").Value = 44
-Range("C28").Value = num
-B28 = Range("B28").Value
-C28 = Range("C28").Value
-If B28 = C28 Then
-Range("D28").Value = "OK"
-Else
-Range("D28").Value = "NG"
-End If
-End Function
-
-Function test_xlMetric(ByRef num)
-Range("A29").Clear
-Range("B29").Clear
-Range("C29").Clear
-Range("D29").Clear
-Range("A29").Value = "xlMetric"
-Range("B29").Value = 35
-Range("C29").Value = num
-B29 = Range("B29").Value
-C29 = Range("C29").Value
-If B29 = C29 Then
-Range("D29").Value = "OK"
-Else
-Range("D29").Value = "NG"
-End If
-End Function
-
-Function test_xlMinuteCode(ByRef num)
-Range("A30").Clear
-Range("B30").Clear
-Range("C30").Clear
-Range("D30").Clear
-Range("A30").Value = "xlMinuteCode"
-Range("B30").Value = 23
-Range("C30").Value = num
-B30 = Range("B30").Value
-C30 = Range("C30").Value
-If B30 = C30 Then
-Range("D30").Value = "OK"
-Else
-Range("D30").Value = "NG"
-End If
-End Function
-
-Function test_xlMonthCode(ByRef num)
-Range("A31").Clear
-Range("B31").Clear
-Range("C31").Clear
-Range("D31").Clear
-Range("A31").Value = "xlMonthCode"
-Range("B31").Value = 20
-Range("C31").Value = num
-B31 = Range("B31").Value
-C31 = Range("C31").Value
-If B31 = C31 Then
-Range("D31").Value = "OK"
-Else
-Range("D31").Value = "NG"
-End If
-End Function
-
-Function test_xlMonthLeadingZero(ByRef num)
-Range("A32").Clear
-Range("B32").Clear
-Range("C32").Clear
-Range("D32").Clear
-Range("A32").Value = "xlMonthLeadingZero"
-Range("B32").Value = 41
-Range("C32").Value = num
-B32 = Range("B32").Value
-C32 = Range("C32").Value
-If B32 = C32 Then
-Range("D32").Value = "OK"
-Else
-Range("D32").Value = "NG"
-End If
-End Function
-
-Function test_xlMonthNameChars(ByRef num)
-Range("A33").Clear
-Range("B33").Clear
-Range("C33").Clear
-Range("D33").Clear
-Range("A33").Value = "xlMonthNameChars"
-Range("B33").Value = 30
-Range("C33").Value = num
-B33 = Range("B33").Value
-C33 = Range("C33").Value
-If B33 = C33 Then
-Range("D33").Value = "OK"
-Else
-Range("D33").Value = "NG"
-End If
-End Function
-
-Function test_xlNocurrencyDigits(ByRef num)
-Range("A34").Clear
-Range("B34").Clear
-Range("C34").Clear
-Range("D34").Clear
-Range("A34").Value = "xlNocurrencyDigits"
-Range("B34").Value = 29
-Range("C34").Value = num
-B34 = Range("B34").Value
-C34 = Range("C34").Value
-If B34 = C34 Then
-Range("D34").Value = "OK"
-Else
-Range("D34").Value = "NG"
-End If
-End Function
-
-Function test_xlNonEnglishFunctions(ByRef num)
-Range("A35").Clear
-Range("B35").Clear
-Range("C35").Clear
-Range("D35").Clear
-Range("A35").Value = "xlNonEnglishFunctions"
-Range("B35").Value = 34
-Range("C35").Value = num
-B35 = Range("B35").Value
-C35 = Range("C35").Value
-If B35 = C35 Then
-Range("D35").Value = "OK"
-Else
-Range("D35").Value = "NG"
-End If
-End Function
-
-Function test_xlRightBrace(ByRef num)
-Range("A36").Clear
-Range("B36").Clear
-Range("C36").Clear
-Range("D36").Clear
-Range("A36").Value = "xlRightBrace"
-Range("B36").Value = 13
-Range("C36").Value = num
-B36 = Range("B36").Value
-C36 = Range("C36").Value
-If B36 = C36 Then
-Range("D36").Value = "OK"
-Else
-Range("D36").Value = "NG"
-End If
-End Function
-
-Function test_xlRightBracket(ByRef num)
-Range("A37").Clear
-Range("B37").Clear
-Range("C37").Clear
-Range("D37").Clear
-Range("A37").Value = "xlRightBracket"
-Range("B37").Value = 11
-Range("C37").Value = num
-B37 = Range("B37").Value
-C37 = Range("C37").Value
-If B37 = C37 Then
-Range("D37").Value = "OK"
-Else
-Range("D37").Value = "NG"
-End If
-End Function
-
-Function test_xlRowSeparator(ByRef num)
-Range("A38").Clear
-Range("B38").Clear
-Range("C38").Clear
-Range("D38").Clear
-Range("A38").Value = "xlRowSeparator"
-Range("B38").Value = 15
-Range("C38").Value = num
-B38 = Range("B38").Value
-C38 = Range("C38").Value
-If B38 = C38 Then
-Range("D38").Value = "OK"
-Else
-Range("D38").Value = "NG"
-End If
-End Function
-
-Function test_xlSecondCode(ByRef num)
-Range("A39").Clear
-Range("B39").Clear
-Range("C39").Clear
-Range("D39").Clear
-Range("A39").Value = "xlSecondCode"
-Range("B39").Value = 24
-Range("C39").Value = num
-B39 = Range("B39").Value
-C39 = Range("C39").Value
-If B39 = C39 Then
-Range("D39").Value = "OK"
-Else
-Range("D39").Value = "NG"
-End If
-End Function
-
-Function test_xlThousandsSeparator(ByRef num)
-Range("A40").Clear
-Range("B40").Clear
-Range("C40").Clear
-Range("D40").Clear
-Range("A40").Value = "xlThousandsSeparator"
-Range("B40").Value = 4
-Range("C40").Value = num
-B40 = Range("B40").Value
-C40 = Range("C40").Value
-If B40 = C40 Then
-Range("D40").Value = "OK"
-Else
-Range("D40").Value = "NG"
-End If
-End Function
-
-Function test_xlTimeLeadingZero(ByRef num)
-Range("A41").Clear
-Range("B41").Clear
-Range("C41").Clear
-Range("D41").Clear
-Range("A41").Value = "xlTimeLeadingZero"
-Range("B41").Value = 45
-Range("C41").Value = num
-B41 = Range("B41").Value
-C41 = Range("C41").Value
-If B41 = C41 Then
-Range("D41").Value = "OK"
-Else
-Range("D41").Value = "NG"
-End If
-End Function
-
-Function test_xlTimeSeparator(ByRef num)
-Range("A42").Clear
-Range("B42").Clear
-Range("C42").Clear
-Range("D42").Clear
-Range("A42").Value = "xlTimeSeparator"
-Range("B42").Value = 18
-Range("C42").Value = num
-B42 = Range("B42").Value
-C42 = Range("C42").Value
-If B42 = C42 Then
-Range("D42").Value = "OK"
-Else
-Range("D42").Value = "NG"
-End If
-End Function
-
-Function test_xlUpperCaseColumnLetter(ByRef num)
-Range("A43").Clear
-Range("B43").Clear
-Range("C43").Clear
-Range("D43").Clear
-Range("A43").Value = "xlUpperCaseColumnLetter"
-Range("B43").Value = 7
-Range("C43").Value = num
-B43 = Range("B43").Value
-C43 = Range("C43").Value
-If B43 = C43 Then
-Range("D43").Value = "OK"
-Else
-Range("D43").Value = "NG"
-End If
-End Function
-
-Function test_xlUpperCaseRowLetter(ByRef num)
-Range("A44").Clear
-Range("B44").Clear
-Range("C44").Clear
-Range("D44").Clear
-Range("A44").Value = "xlUpperCaseRowLetter"
-Range("B44").Value = 6
-Range("C44").Value = num
-B44 = Range("B44").Value
-C44 = Range("C44").Value
-If B44 = C44 Then
-Range("D44").Value = "OK"
-Else
-Range("D44").Value = "NG"
-End If
-End Function
-
-Function test_xlWeekdayNameChars(ByRef num)
-Range("A45").Clear
-Range("B45").Clear
-Range("C45").Clear
-Range("D45").Clear
-Range("A45").Value = "xlWeekdayNameChars"
-Range("B45").Value = 31
-Range("C45").Value = num
-B45 = Range("B45").Value
-C45 = Range("C45").Value
-If B45 = C45 Then
-Range("D45").Value = "OK"
-Else
-Range("D45").Value = "NG"
-End If
-End Function
-
-Function test_xlYearCode(ByRef num)
-Range("A46").Clear
-Range("B46").Clear
-Range("C46").Clear
-Range("D46").Clear
-Range("A46").Value = "xlYearCode"
-Range("B46").Value = 19
-Range("C46").Value = num
-B46 = Range("B46").Value
-C46 = Range("C46").Value
-If B46 = C46 Then
-Range("D46").Value = "OK"
-Else
-Range("D46").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnThenRow(ByRef num)
-Range("A47").Clear
-Range("B47").Clear
-Range("C47").Clear
-Range("D47").Clear
-Range("A47").Value = "xlColumnThenRow"
-Range("B47").Value = 2
-Range("C47").Value = num
-B47 = Range("B47").Value
-C47 = Range("C47").Value
-If B47 = C47 Then
-Range("D47").Value = "OK"
-Else
-Range("D47").Value = "NG"
-End If
-End Function
-
-Function test_xlRowThenColumn(ByRef num)
-Range("A48").Clear
-Range("B48").Clear
-Range("C48").Clear
-Range("D48").Clear
-Range("A48").Value = "xlRowThenColumn"
-Range("B48").Value = 1
-Range("C48").Value = num
-B48 = Range("B48").Value
-C48 = Range("C48").Value
-If B48 = C48 Then
-Range("D48").Value = "OK"
-Else
-Range("D48").Value = "NG"
-End If
-End Function
-
-Function test_xlArabicBothStrict(ByRef num)
-Range("A49").Clear
-Range("B49").Clear
-Range("C49").Clear
-Range("D49").Clear
-Range("A49").Value = "xlArabicBothStrict"
-Range("B49").Value = 3
-Range("C49").Value = num
-B49 = Range("B49").Value
-C49 = Range("C49").Value
-If B49 = C49 Then
-Range("D49").Value = "OK"
-Else
-Range("D49").Value = "NG"
-End If
-End Function
-
-Function test_xlArabicNone(ByRef num)
-Range("A50").Clear
-Range("B50").Clear
-Range("C50").Clear
-Range("D50").Clear
-Range("A50").Value = "xlArabicNone"
-Range("B50").Value = 0
-Range("C50").Value = num
-B50 = Range("B50").Value
-C50 = Range("C50").Value
-If B50 = C50 Then
-Range("D50").Value = "OK"
-Else
-Range("D50").Value = "NG"
-End If
-End Function
-
-Function test_xlArabicStrictAlefHamza(ByRef num)
-Range("A51").Clear
-Range("B51").Clear
-Range("C51").Clear
-Range("D51").Clear
-Range("A51").Value = "xlArabicStrictAlefHamza"
-Range("B51").Value = 1
-Range("C51").Value = num
-B51 = Range("B51").Value
-C51 = Range("C51").Value
-If B51 = C51 Then
-Range("D51").Value = "OK"
-Else
-Range("D51").Value = "NG"
-End If
-End Function
-
-Function test_xlArabicStrictFinalYaa(ByRef num)
-Range("A52").Clear
-Range("B52").Clear
-Range("C52").Clear
-Range("D52").Clear
-Range("A52").Value = "xlArabicStrictFinalYaa"
-Range("B52").Value = 2
-Range("C52").Value = num
-B52 = Range("B52").Value
-C52 = Range("C52").Value
-If B52 = C52 Then
-Range("D52").Value = "OK"
-Else
-Range("D52").Value = "NG"
-End If
-End Function
-
-Function test_xlArrangeStyleCascade(ByRef num)
-Range("A53").Clear
-Range("B53").Clear
-Range("C53").Clear
-Range("D53").Clear
-Range("A53").Value = "xlArrangeStyleCascade"
-Range("B53").Value = 7
-Range("C53").Value = num
-B53 = Range("B53").Value
-C53 = Range("C53").Value
-If B53 = C53 Then
-Range("D53").Value = "OK"
-Else
-Range("D53").Value = "NG"
-End If
-End Function
-
-Function test_xlArrangeStyleHorizontal(ByRef num)
-Range("A54").Clear
-Range("B54").Clear
-Range("C54").Clear
-Range("D54").Clear
-Range("A54").Value = "xlArrangeStyleHorizontal"
-Range("B54").Value = -4128
-Range("C54").Value = num
-B54 = Range("B54").Value
-C54 = Range("C54").Value
-If B54 = C54 Then
-Range("D54").Value = "OK"
-Else
-Range("D54").Value = "NG"
-End If
-End Function
-
-Function test_xlArrangeStyleTiled(ByRef num)
-Range("A55").Clear
-Range("B55").Clear
-Range("C55").Clear
-Range("D55").Clear
-Range("A55").Value = "xlArrangeStyleTiled"
-Range("B55").Value = 1
-Range("C55").Value = num
-B55 = Range("B55").Value
-C55 = Range("C55").Value
-If B55 = C55 Then
-Range("D55").Value = "OK"
-Else
-Range("D55").Value = "NG"
-End If
-End Function
-
-Function test_xlArrangeStyleVertical(ByRef num)
-Range("A56").Clear
-Range("B56").Clear
-Range("C56").Clear
-Range("D56").Clear
-Range("A56").Value = "xlArrangeStyleVertical"
-Range("B56").Value = -4166
-Range("C56").Value = num
-B56 = Range("B56").Value
-C56 = Range("C56").Value
-If B56 = C56 Then
-Range("D56").Value = "OK"
-Else
-Range("D56").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadLengthLong(ByRef num)
-Range("A57").Clear
-Range("B57").Clear
-Range("C57").Clear
-Range("D57").Clear
-Range("A57").Value = "xlArrowHeadLengthLong"
-Range("B57").Value = 3
-Range("C57").Value = num
-B57 = Range("B57").Value
-C57 = Range("C57").Value
-If B57 = C57 Then
-Range("D57").Value = "OK"
-Else
-Range("D57").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadLengthMedium(ByRef num)
-Range("A58").Clear
-Range("B58").Clear
-Range("C58").Clear
-Range("D58").Clear
-Range("A58").Value = "xlArrowHeadLengthMedium"
-Range("B58").Value = -4138
-Range("C58").Value = num
-B58 = Range("B58").Value
-C58 = Range("C58").Value
-If B58 = C58 Then
-Range("D58").Value = "OK"
-Else
-Range("D58").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadLengthShort(ByRef num)
-Range("A59").Clear
-Range("B59").Clear
-Range("C59").Clear
-Range("D59").Clear
-Range("A59").Value = "xlArrowHeadLengthShort"
-Range("B59").Value = 1
-Range("C59").Value = num
-B59 = Range("B59").Value
-C59 = Range("C59").Value
-If B59 = C59 Then
-Range("D59").Value = "OK"
-Else
-Range("D59").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadStyleClosed(ByRef num)
-Range("A60").Clear
-Range("B60").Clear
-Range("C60").Clear
-Range("D60").Clear
-Range("A60").Value = "xlArrowHeadStyleClosed"
-Range("B60").Value = 3
-Range("C60").Value = num
-B60 = Range("B60").Value
-C60 = Range("C60").Value
-If B60 = C60 Then
-Range("D60").Value = "OK"
-Else
-Range("D60").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadStyleDoubleClosed(ByRef num)
-Range("A61").Clear
-Range("B61").Clear
-Range("C61").Clear
-Range("D61").Clear
-Range("A61").Value = "xlArrowHeadStyleDoubleClosed"
-Range("B61").Value = 4
-Range("C61").Value = num
-B61 = Range("B61").Value
-C61 = Range("C61").Value
-If B61 = C61 Then
-Range("D61").Value = "OK"
-Else
-Range("D61").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadStyleDoubleOpen(ByRef num)
-Range("A62").Clear
-Range("B62").Clear
-Range("C62").Clear
-Range("D62").Clear
-Range("A62").Value = "xlArrowHeadStyleDoubleOpen"
-Range("B62").Value = 5
-Range("C62").Value = num
-B62 = Range("B62").Value
-C62 = Range("C62").Value
-If B62 = C62 Then
-Range("D62").Value = "OK"
-Else
-Range("D62").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadStyleNone(ByRef num)
-Range("A63").Clear
-Range("B63").Clear
-Range("C63").Clear
-Range("D63").Clear
-Range("A63").Value = "xlArrowHeadStyleNone"
-Range("B63").Value = -4142
-Range("C63").Value = num
-B63 = Range("B63").Value
-C63 = Range("C63").Value
-If B63 = C63 Then
-Range("D63").Value = "OK"
-Else
-Range("D63").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadStyleOpen(ByRef num)
-Range("A64").Clear
-Range("B64").Clear
-Range("C64").Clear
-Range("D64").Clear
-Range("A64").Value = "xlArrowHeadStyleOpen"
-Range("B64").Value = 2
-Range("C64").Value = num
-B64 = Range("B64").Value
-C64 = Range("C64").Value
-If B64 = C64 Then
-Range("D64").Value = "OK"
-Else
-Range("D64").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadWidthMedium(ByRef num)
-Range("A65").Clear
-Range("B65").Clear
-Range("C65").Clear
-Range("D65").Clear
-Range("A65").Value = "xlArrowHeadWidthMedium"
-Range("B65").Value = -4138
-Range("C65").Value = num
-B65 = Range("B65").Value
-C65 = Range("C65").Value
-If B65 = C65 Then
-Range("D65").Value = "OK"
-Else
-Range("D65").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadWidthNarrow(ByRef num)
-Range("A66").Clear
-Range("B66").Clear
-Range("C66").Clear
-Range("D66").Clear
-Range("A66").Value = "xlArrowHeadWidthNarrow"
-Range("B66").Value = 1
-Range("C66").Value = num
-B66 = Range("B66").Value
-C66 = Range("C66").Value
-If B66 = C66 Then
-Range("D66").Value = "OK"
-Else
-Range("D66").Value = "NG"
-End If
-End Function
-
-Function test_xlArrowHeadWidthWide(ByRef num)
-Range("A67").Clear
-Range("B67").Clear
-Range("C67").Clear
-Range("D67").Clear
-Range("A67").Value = "xlArrowHeadWidthWide"
-Range("B67").Value = 3
-Range("C67").Value = num
-B67 = Range("B67").Value
-C67 = Range("C67").Value
-If B67 = C67 Then
-Range("D67").Value = "OK"
-Else
-Range("D67").Value = "NG"
-End If
-End Function
-
-Function test_xlFillCopy(ByRef num)
-Range("A68").Clear
-Range("B68").Clear
-Range("C68").Clear
-Range("D68").Clear
-Range("A68").Value = "xlFillCopy"
-Range("B68").Value = 1
-Range("C68").Value = num
-B68 = Range("B68").Value
-C68 = Range("C68").Value
-If B68 = C68 Then
-Range("D68").Value = "OK"
-Else
-Range("D68").Value = "NG"
-End If
-End Function
-
-Function test_xlFillDays(ByRef num)
-Range("A69").Clear
-Range("B69").Clear
-Range("C69").Clear
-Range("D69").Clear
-Range("A69").Value = "xlFillDays"
-Range("B69").Value = 5
-Range("C69").Value = num
-B69 = Range("B69").Value
-C69 = Range("C69").Value
-If B69 = C69 Then
-Range("D69").Value = "OK"
-Else
-Range("D69").Value = "NG"
-End If
-End Function
-
-Function test_xlFillDefault(ByRef num)
-Range("A70").Clear
-Range("B70").Clear
-Range("C70").Clear
-Range("D70").Clear
-Range("A70").Value = "xlFillDefault"
-Range("B70").Value = 0
-Range("C70").Value = num
-B70 = Range("B70").Value
-C70 = Range("C70").Value
-If B70 = C70 Then
-Range("D70").Value = "OK"
-Else
-Range("D70").Value = "NG"
-End If
-End Function
-
-Function test_xlFillFormats(ByRef num)
-Range("A71").Clear
-Range("B71").Clear
-Range("C71").Clear
-Range("D71").Clear
-Range("A71").Value = "xlFillFormats"
-Range("B71").Value = 3
-Range("C71").Value = num
-B71 = Range("B71").Value
-C71 = Range("C71").Value
-If B71 = C71 Then
-Range("D71").Value = "OK"
-Else
-Range("D71").Value = "NG"
-End If
-End Function
-
-Function test_xlFillMonths(ByRef num)
-Range("A72").Clear
-Range("B72").Clear
-Range("C72").Clear
-Range("D72").Clear
-Range("A72").Value = "xlFillMonths"
-Range("B72").Value = 7
-Range("C72").Value = num
-B72 = Range("B72").Value
-C72 = Range("C72").Value
-If B72 = C72 Then
-Range("D72").Value = "OK"
-Else
-Range("D72").Value = "NG"
-End If
-End Function
-
-Function test_xlFillSeries(ByRef num)
-Range("A73").Clear
-Range("B73").Clear
-Range("C73").Clear
-Range("D73").Clear
-Range("A73").Value = "xlFillSeries"
-Range("B73").Value = 2
-Range("C73").Value = num
-B73 = Range("B73").Value
-C73 = Range("C73").Value
-If B73 = C73 Then
-Range("D73").Value = "OK"
-Else
-Range("D73").Value = "NG"
-End If
-End Function
-
-Function test_xlFillValues(ByRef num)
-Range("A74").Clear
-Range("B74").Clear
-Range("C74").Clear
-Range("D74").Clear
-Range("A74").Value = "xlFillValues"
-Range("B74").Value = 4
-Range("C74").Value = num
-B74 = Range("B74").Value
-C74 = Range("C74").Value
-If B74 = C74 Then
-Range("D74").Value = "OK"
-Else
-Range("D74").Value = "NG"
-End If
-End Function
-
-Function test_xlFillWeekdays(ByRef num)
-Range("A75").Clear
-Range("B75").Clear
-Range("C75").Clear
-Range("D75").Clear
-Range("A75").Value = "xlFillWeekdays"
-Range("B75").Value = 6
-Range("C75").Value = num
-B75 = Range("B75").Value
-C75 = Range("C75").Value
-If B75 = C75 Then
-Range("D75").Value = "OK"
-Else
-Range("D75").Value = "NG"
-End If
-End Function
-
-Function test_xlFillYears(ByRef num)
-Range("A76").Clear
-Range("B76").Clear
-Range("C76").Clear
-Range("D76").Clear
-Range("A76").Value = "xlFillYears"
-Range("B76").Value = 8
-Range("C76").Value = num
-B76 = Range("B76").Value
-C76 = Range("C76").Value
-If B76 = C76 Then
-Range("D76").Value = "OK"
-Else
-Range("D76").Value = "NG"
-End If
-End Function
-
-Function test_xlGrowthTrend(ByRef num)
-Range("A77").Clear
-Range("B77").Clear
-Range("C77").Clear
-Range("D77").Clear
-Range("A77").Value = "xlGrowthTrend"
-Range("B77").Value = 10
-Range("C77").Value = num
-B77 = Range("B77").Value
-C77 = Range("C77").Value
-If B77 = C77 Then
-Range("D77").Value = "OK"
-Else
-Range("D77").Value = "NG"
-End If
-End Function
-
-Function test_xlLinearTrend(ByRef num)
-Range("A78").Clear
-Range("B78").Clear
-Range("C78").Clear
-Range("D78").Clear
-Range("A78").Value = "xlLinearTrend"
-Range("B78").Value = 9
-Range("C78").Value = num
-B78 = Range("B78").Value
-C78 = Range("C78").Value
-If B78 = C78 Then
-Range("D78").Value = "OK"
-Else
-Range("D78").Value = "NG"
-End If
-End Function
-
-Function test_xlAnd(ByRef num)
-Range("A79").Clear
-Range("B79").Clear
-Range("C79").Clear
-Range("D79").Clear
-Range("A79").Value = "xlAnd"
-Range("B79").Value = 1
-Range("C79").Value = num
-B79 = Range("B79").Value
-C79 = Range("C79").Value
-If B79 = C79 Then
-Range("D79").Value = "OK"
-Else
-Range("D79").Value = "NG"
-End If
-End Function
-
-Function test_xlBottom10Items(ByRef num)
-Range("A80").Clear
-Range("B80").Clear
-Range("C80").Clear
-Range("D80").Clear
-Range("A80").Value = "xlBottom10Items"
-Range("B80").Value = 4
-Range("C80").Value = num
-B80 = Range("B80").Value
-C80 = Range("C80").Value
-If B80 = C80 Then
-Range("D80").Value = "OK"
-Else
-Range("D80").Value = "NG"
-End If
-End Function
-
-Function test_xlBottom10Percent(ByRef num)
-Range("A81").Clear
-Range("B81").Clear
-Range("C81").Clear
-Range("D81").Clear
-Range("A81").Value = "xlBottom10Percent"
-Range("B81").Value = 6
-Range("C81").Value = num
-B81 = Range("B81").Value
-C81 = Range("C81").Value
-If B81 = C81 Then
-Range("D81").Value = "OK"
-Else
-Range("D81").Value = "NG"
-End If
-End Function
-
-Function test_xlOr(ByRef num)
-Range("A82").Clear
-Range("B82").Clear
-Range("C82").Clear
-Range("D82").Clear
-Range("A82").Value = "xlOr"
-Range("B82").Value = 2
-Range("C82").Value = num
-B82 = Range("B82").Value
-C82 = Range("C82").Value
-If B82 = C82 Then
-Range("D82").Value = "OK"
-Else
-Range("D82").Value = "NG"
-End If
-End Function
-
-Function test_xlTop10Items(ByRef num)
-Range("A83").Clear
-Range("B83").Clear
-Range("C83").Clear
-Range("D83").Clear
-Range("A83").Value = "xlTop10Items"
-Range("B83").Value = 3
-Range("C83").Value = num
-B83 = Range("B83").Value
-C83 = Range("C83").Value
-If B83 = C83 Then
-Range("D83").Value = "OK"
-Else
-Range("D83").Value = "NG"
-End If
-End Function
-
-Function test_xlTop10Percent(ByRef num)
-Range("A84").Clear
-Range("B84").Clear
-Range("C84").Clear
-Range("D84").Clear
-Range("A84").Value = "xlTop10Percent"
-Range("B84").Value = 5
-Range("C84").Value = num
-B84 = Range("B84").Value
-C84 = Range("C84").Value
-If B84 = C84 Then
-Range("D84").Value = "OK"
-Else
-Range("D84").Value = "NG"
-End If
-End Function
-
-Function test_xlAxisCrossesAutomatic(ByRef num)
-Range("A85").Clear
-Range("B85").Clear
-Range("C85").Clear
-Range("D85").Clear
-Range("A85").Value = "xlAxisCrossesAutomatic"
-Range("B85").Value = -4105
-Range("C85").Value = num
-B85 = Range("B85").Value
-C85 = Range("C85").Value
-If B85 = C85 Then
-Range("D85").Value = "OK"
-Else
-Range("D85").Value = "NG"
-End If
-End Function
-
-Function test_xlAxisCrossesCustom(ByRef num)
-Range("A86").Clear
-Range("B86").Clear
-Range("C86").Clear
-Range("D86").Clear
-Range("A86").Value = "xlAxisCrossesCustom"
-Range("B86").Value = -4114
-Range("C86").Value = num
-B86 = Range("B86").Value
-C86 = Range("C86").Value
-If B86 = C86 Then
-Range("D86").Value = "OK"
-Else
-Range("D86").Value = "NG"
-End If
-End Function
-
-Function test_xlAxisCrossesMaximum(ByRef num)
-Range("A87").Clear
-Range("B87").Clear
-Range("C87").Clear
-Range("D87").Clear
-Range("A87").Value = "xlAxisCrossesMaximum"
-Range("B87").Value = 2
-Range("C87").Value = num
-B87 = Range("B87").Value
-C87 = Range("C87").Value
-If B87 = C87 Then
-Range("D87").Value = "OK"
-Else
-Range("D87").Value = "NG"
-End If
-End Function
-
-Function test_xlAxisCrossesMinimum(ByRef num)
-Range("A88").Clear
-Range("B88").Clear
-Range("C88").Clear
-Range("D88").Clear
-Range("A88").Value = "xlAxisCrossesMinimum"
-Range("B88").Value = 4
-Range("C88").Value = num
-B88 = Range("B88").Value
-C88 = Range("C88").Value
-If B88 = C88 Then
-Range("D88").Value = "OK"
-Else
-Range("D88").Value = "NG"
-End If
-End Function
-
-Function test_xlPrimary(ByRef num)
-Range("A89").Clear
-Range("B89").Clear
-Range("C89").Clear
-Range("D89").Clear
-Range("A89").Value = "xlPrimary"
-Range("B89").Value = 1
-Range("C89").Value = num
-B89 = Range("B89").Value
-C89 = Range("C89").Value
-If B89 = C89 Then
-Range("D89").Value = "OK"
-Else
-Range("D89").Value = "NG"
-End If
-End Function
-
-Function test_xlSecondary(ByRef num)
-Range("A90").Clear
-Range("B90").Clear
-Range("C90").Clear
-Range("D90").Clear
-Range("A90").Value = "xlSecondary"
-Range("B90").Value = 2
-Range("C90").Value = num
-B90 = Range("B90").Value
-C90 = Range("C90").Value
-If B90 = C90 Then
-Range("D90").Value = "OK"
-Else
-Range("D90").Value = "NG"
-End If
-End Function
-
-Function test_xlCategory(ByRef num)
-Range("A91").Clear
-Range("B91").Clear
-Range("C91").Clear
-Range("D91").Clear
-Range("A91").Value = "xlCategory"
-Range("B91").Value = 1
-Range("C91").Value = num
-B91 = Range("B91").Value
-C91 = Range("C91").Value
-If B91 = C91 Then
-Range("D91").Value = "OK"
-Else
-Range("D91").Value = "NG"
-End If
-End Function
-
-Function test_xlSeriesAxis(ByRef num)
-Range("A92").Clear
-Range("B92").Clear
-Range("C92").Clear
-Range("D92").Clear
-Range("A92").Value = "xlSeriesAxis"
-Range("B92").Value = 3
-Range("C92").Value = num
-B92 = Range("B92").Value
-C92 = Range("C92").Value
-If B92 = C92 Then
-Range("D92").Value = "OK"
-Else
-Range("D92").Value = "NG"
-End If
-End Function
-
-Function test_xlValue(ByRef num)
-Range("A93").Clear
-Range("B93").Clear
-Range("C93").Clear
-Range("D93").Clear
-Range("A93").Value = "xlValue"
-Range("B93").Value = 2
-Range("C93").Value = num
-B93 = Range("B93").Value
-C93 = Range("C93").Value
-If B93 = C93 Then
-Range("D93").Value = "OK"
-Else
-Range("D93").Value = "NG"
-End If
-End Function
-
-<<<<<<
-======================
-Module2
->>>>>>
-Attribute VB_Name = "Module2"
-
-Sub main_2()
-test_xlBackgroundAutomatic (xlBackgroundAutomatic)
-test_xlBackgroundOpaque (xlBackgroundOpaque)
-test_xlBackgroundTransparent (xlBackgroundTransparent)
-test_xlHairline (xlHairline)
-test_xlMedium (xlMedium)
-test_xlThick (xlThick)
-test_xlThin (xlThin)
-test_xlBox (xlBox)
-test_xlConeToMax (xlConeToMax)
-test_xlConeToPoint (xlConeToPoint)
-test_xlCylinder (xlCylinder)
-test_xlPyramidToMax (xlPyramidToMax)
-test_xlPyramidToPoint (xlPyramidToPoint)
-Range("A1").Value = "constant name"
-Range("B1").Value = "OOo result"
-Range("C1").Value = "Excel result"
-Range("D1").Value = "Correct?"
-End Sub
-
-Function test_xlBackgroundAutomatic(ByRef num)
-Range("A2").Clear
-Range("B2").Clear
-Range("C2").Clear
-Range("D2").Clear
-Range("A2").Value = "xlBackgroundAutomatic"
-Range("B2").Value = -4105
-Range("C2").Value = num
-B2 = Range("B2").Value
-C2 = Range("C2").Value
-If B2 = C2 Then
-Range("D2").Value = "OK"
-Else
-Range("D2").Value = "NG"
-End If
-End Function
-
-Function test_xlBackgroundOpaque(ByRef num)
-Range("A3").Clear
-Range("B3").Clear
-Range("C3").Clear
-Range("D3").Clear
-Range("A3").Value = "xlBackgroundOpaque"
-Range("B3").Value = 3
-Range("C3").Value = num
-B3 = Range("B3").Value
-C3 = Range("C3").Value
-If B3 = C3 Then
-Range("D3").Value = "OK"
-Else
-Range("D3").Value = "NG"
-End If
-End Function
-
-Function test_xlBackgroundTransparent(ByRef num)
-Range("A4").Clear
-Range("B4").Clear
-Range("C4").Clear
-Range("D4").Clear
-Range("A4").Value = "xlBackgroundTransparent"
-Range("B4").Value = 2
-Range("C4").Value = num
-B4 = Range("B4").Value
-C4 = Range("C4").Value
-If B4 = C4 Then
-Range("D4").Value = "OK"
-Else
-Range("D4").Value = "NG"
-End If
-End Function
-
-Function test_xlHairline(ByRef num)
-Range("A5").Clear
-Range("B5").Clear
-Range("C5").Clear
-Range("D5").Clear
-Range("A5").Value = "xlHairline"
-Range("B5").Value = 1
-Range("C5").Value = num
-B5 = Range("B5").Value
-C5 = Range("C5").Value
-If B5 = C5 Then
-Range("D5").Value = "OK"
-Else
-Range("D5").Value = "NG"
-End If
-End Function
-
-Function test_xlMedium(ByRef num)
-Range("A6").Clear
-Range("B6").Clear
-Range("C6").Clear
-Range("D6").Clear
-Range("A6").Value = "xlMedium"
-Range("B6").Value = -4138
-Range("C6").Value = num
-B6 = Range("B6").Value
-C6 = Range("C6").Value
-If B6 = C6 Then
-Range("D6").Value = "OK"
-Else
-Range("D6").Value = "NG"
-End If
-End Function
-
-Function test_xlThick(ByRef num)
-Range("A7").Clear
-Range("B7").Clear
-Range("C7").Clear
-Range("D7").Clear
-Range("A7").Value = "xlThick"
-Range("B7").Value = 4
-Range("C7").Value = num
-B7 = Range("B7").Value
-C7 = Range("C7").Value
-If B7 = C7 Then
-Range("D7").Value = "OK"
-Else
-Range("D7").Value = "NG"
-End If
-End Function
-
-Function test_xlThin(ByRef num)
-Range("A8").Clear
-Range("B8").Clear
-Range("C8").Clear
-Range("D8").Clear
-Range("A8").Value = "xlThin"
-Range("B8").Value = 2
-Range("C8").Value = num
-B8 = Range("B8").Value
-C8 = Range("C8").Value
-If B8 = C8 Then
-Range("D8").Value = "OK"
-Else
-Range("D8").Value = "NG"
-End If
-End Function
-
-Function test_xlBox(ByRef num)
-Range("A9").Clear
-Range("B9").Clear
-Range("C9").Clear
-Range("D9").Clear
-Range("A9").Value = "xlBox"
-Range("B9").Value = 0
-Range("C9").Value = num
-B9 = Range("B9").Value
-C9 = Range("C9").Value
-If B9 = C9 Then
-Range("D9").Value = "OK"
-Else
-Range("D9").Value = "NG"
-End If
-End Function
-
-Function test_xlConeToMax(ByRef num)
-Range("A10").Clear
-Range("B10").Clear
-Range("C10").Clear
-Range("D10").Clear
-Range("A10").Value = "xlConeToMax"
-Range("B10").Value = 5
-Range("C10").Value = num
-B10 = Range("B10").Value
-C10 = Range("C10").Value
-If B10 = C10 Then
-Range("D10").Value = "OK"
-Else
-Range("D10").Value = "NG"
-End If
-End Function
-
-Function test_xlConeToPoint(ByRef num)
-Range("A11").Clear
-Range("B11").Clear
-Range("C11").Clear
-Range("D11").Clear
-Range("A11").Value = "xlConeToPoint"
-Range("B11").Value = 4
-Range("C11").Value = num
-B11 = Range("B11").Value
-C11 = Range("C11").Value
-If B11 = C11 Then
-Range("D11").Value = "OK"
-Else
-Range("D11").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinder(ByRef num)
-Range("A12").Clear
-Range("B12").Clear
-Range("C12").Clear
-Range("D12").Clear
-Range("A12").Value = "xlCylinder"
-Range("B12").Value = 3
-Range("C12").Value = num
-B12 = Range("B12").Value
-C12 = Range("C12").Value
-If B12 = C12 Then
-Range("D12").Value = "OK"
-Else
-Range("D12").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidToMax(ByRef num)
-Range("A13").Clear
-Range("B13").Clear
-Range("C13").Clear
-Range("D13").Clear
-Range("A13").Value = "xlPyramidToMax"
-Range("B13").Value = 2
-Range("C13").Value = num
-B13 = Range("B13").Value
-C13 = Range("C13").Value
-If B13 = C13 Then
-Range("D13").Value = "OK"
-Else
-Range("D13").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidToPoint(ByRef num)
-Range("A14").Clear
-Range("B14").Clear
-Range("C14").Clear
-Range("D14").Clear
-Range("A14").Value = "xlPyramidToPoint"
-Range("B14").Value = 1
-Range("C14").Value = num
-B14 = Range("B14").Value
-C14 = Range("C14").Value
-If B14 = C14 Then
-Range("D14").Value = "OK"
-Else
-Range("D14").Value = "NG"
-End If
-End Function
-
-<<<<<<
-======================
-Module3
->>>>>>
-Attribute VB_Name = "Module3"
-Sub main_3()
-test_xlDialogActivate (xlDialogActivate)
-test_xlDialogActiveCellFont (xlDialogActiveCellFont)
-test_xlDialogAddChartAutoformat (xlDialogAddChartAutoformat)
-test_xlDialogAddinManager (xlDialogAddinManager)
-test_xlDialogAlignment (xlDialogAlignment)
-test_xlDialogApplyNames (xlDialogApplyNames)
-test_xlDialogApplyStyle (xlDialogApplyStyle)
-test_xlDialogAppMove (xlDialogAppMove)
-test_xlDialogAppSize (xlDialogAppSize)
-test_xlDialogArrangeAll (xlDialogArrangeAll)
-test_xlDialogAssignToObject (xlDialogAssignToObject)
-test_xlDialogAssignToTool (xlDialogAssignToTool)
-test_xlDialogAttachText (xlDialogAttachText)
-test_xlDialogAttachToolbars (xlDialogAttachToolbars)
-test_xlDialogAutoCorrect (xlDialogAutoCorrect)
-test_xlDialogAxes (xlDialogAxes)
-test_xlDialogBorder (xlDialogBorder)
-test_xlDialogCalculation (xlDialogCalculation)
-test_xlDialogCellProtection (xlDialogCellProtection)
-test_xlDialogChangeLink (xlDialogChangeLink)
-test_xlDialogChartAddData (xlDialogChartAddData)
-test_xlDialogChartLocation (xlDialogChartLocation)
-test_xlDialogChartOptionDataLabelMultiple (xlDialogChartOptionDataLabelMultiple)
-test_xlDialogChartOptionDataLabels (xlDialogChartOptionDataLabels)
-test_xlDialogChartOptionDataTable (xlDialogChartOptionDataTable)
-test_xlDialogChartSourceData (xlDialogChartSourceData)
-test_xlDialogChartTrend (xlDialogChartTrend)
-test_xlDialogChartType (xlDialogChartType)
-test_xlDialogChartWizard (xlDialogChartWizard)
-test_xlDialogChechboxProperties (xlDialogChechboxProperties)
-test_xlDialogClear (xlDialogClear)
-test_xlDialogColorPalette (xlDialogColorPalette)
-test_xlDialogColumnWidth (xlDialogColumnWidth)
-test_xlDialogCombination (xlDialogCombination)
-test_xlDialogConditionalFormatting (xlDialogConditionalFormatting)
-test_xlDialogConsolidate (xlDialogConsolidate)
-test_xlDialogCopyChart (xlDialogCopyChart)
-test_xlDialogCopyPicture (xlDialogCopyPicture)
-test_xlDialogCreateList (xlDialogCreateList)
-test_xlDialogCreateNames (xlDialogCreateNames)
-test_xlDialogCreatePublisher (xlDialogCreatePublisher)
-test_xlDialogCustomizeToolbar (xlDialogCustomizeToolbar)
-test_xlDialogCustomViews (xlDialogCustomViews)
-test_xlDialogDataDelete (xlDialogDataDelete)
-test_xlDialogDataLabel (xlDialogDataLabel)
-test_xlDialogDataLabelMultiple (xlDialogDataLabelMultiple)
-test_xlDialogDataSeries (xlDialogDataSeries)
-test_xlDialogDataValidation (xlDialogDataValidation)
-test_xlDialogDefineName (xlDialogDefineName)
-test_xlDialogDefineStyle (xlDialogDefineStyle)
-test_xlDialogDeleteFormat (xlDialogDeleteFormat)
-test_xlDialogDeleteName (xlDialogDeleteName)
-test_xlDialogDemote (xlDialogDemote)
-test_xlDialogDisplay (xlDialogDisplay)
-test_xlDialogEditboxProperties (xlDialogEditboxProperties)
-test_xlDialogEditColor (xlDialogEditColor)
-test_xlDialogEditDelete (xlDialogEditDelete)
-test_xlDialogEditionOptions (xlDialogEditionOptions)
-test_xlDialogEditSeries (xlDialogEditSeries)
-test_xlDialogErrorbarX (xlDialogErrorbarX)
-test_xlDialogErrorbarY (xlDialogErrorbarY)
-test_xlDialogErrorChecking (xlDialogErrorChecking)
-test_xlDialogEvaluateFormula (xlDialogEvaluateFormula)
-test_xlDialogExternalDataProperties (xlDialogExternalDataProperties)
-test_xlDialogExtract (xlDialogExtract)
-test_xlDialogFileDelete (xlDialogFileDelete)
-test_xlDialogFileSharing (xlDialogFileSharing)
-test_xlDialogFillGroup (xlDialogFillGroup)
-test_xlDialogFillWorkGroup (xlDialogFillWorkGroup)
-test_xlDialogFilter (xlDialogFilter)
-test_xlDialogFilterAdvanced (xlDialogFilterAdvanced)
-test_xlDialogFindFile (xlDialogFindFile)
-test_xlDialogFont (xlDialogFont)
-test_xlDialogFontProperties (xlDialogFontProperties)
-test_xlDialogFormatAuto (xlDialogFormatAuto)
-test_xlDialogFormatChart (xlDialogFormatChart)
-test_xlDialogFormatCharttype (xlDialogFormatCharttype)
-test_xlDialogFormatFont (xlDialogFormatFont)
-test_xlDialogFormatLegend (xlDialogFormatLegend)
-test_xlDialogFormatMain (xlDialogFormatMain)
-test_xlDialogFormatMove (xlDialogFormatMove)
-test_xlDialogFormatNumber (xlDialogFormatNumber)
-test_xlDialogFormatOverlay (xlDialogFormatOverlay)
-test_xlDialogFormatSize (xlDialogFormatSize)
-test_xlDialogFormatText (xlDialogFormatText)
-test_xlDialogFormulaFind (xlDialogFormulaFind)
-test_xlDialogFormulaGoto (xlDialogFormulaGoto)
-test_xlDialogFormulaReplace (xlDialogFormulaReplace)
-test_xlDialogFunctionWizard (xlDialogFunctionWizard)
-test_xlDialogGallery3dArea (xlDialogGallery3dArea)
-test_xlDialogGallery3dBar (xlDialogGallery3dBar)
-test_xlDialogGallery3dColumn (xlDialogGallery3dColumn)
-test_xlDialogGallery3dLine (xlDialogGallery3dLine)
-test_xlDialogGallery3dPie (xlDialogGallery3dPie)
-test_xlDialogGallery3dSurface (xlDialogGallery3dSurface)
-test_xlDialogGalleryArea (xlDialogGalleryArea)
-test_xlDialogGalleryBar (xlDialogGalleryBar)
-test_xlDialogGalleryColumn (xlDialogGalleryColumn)
-test_xlDialogGalleryCustom (xlDialogGalleryCustom)
-test_xlDialogGalleryDoughnut (xlDialogGalleryDoughnut)
-test_xlDialogGalleryLine (xlDialogGalleryLine)
-test_xlDialogGalleryPie (xlDialogGalleryPie)
-test_xlDialogGalleryRader (xlDialogGalleryRader)
-test_xlDialogGalleryScatter (xlDialogGalleryScatter)
-test_xlDialogGoalSeek (xlDialogGoalSeek)
-test_xlDialogGridlines (xlDialogGridlines)
-test_xlDialogImportTextFile (xlDialogImportTextFile)
-test_xlDialogInsert (xlDialogInsert)
-test_xlDialogInsertHyperlink (xlDialogInsertHyperlink)
-test_xlDialogInsertNameLabel (xlDialogInsertNameLabel)
-test_xlDialogInsertObject (xlDialogInsertObject)
-test_xlDialogInsertPicture (xlDialogInsertPicture)
-test_xlDialogInsertTitle (xlDialogInsertTitle)
-test_xlDialogLabelProperties (xlDialogLabelProperties)
-test_xlDialogListboxProperties (xlDialogListboxProperties)
-test_xlDialogMacroOptions (xlDialogMacroOptions)
-test_xlDialogMailEditMailer (xlDialogMailEditMailer)
-test_xlDialogMailLogon (xlDialogMailLogon)
-test_xlDialogMailNextLetter (xlDialogMailNextLetter)
-test_xlDialogMainChart (xlDialogMainChart)
-test_xlDialogMainChartType (xlDialogMainChartType)
-test_xlDialogMenuEditor (xlDialogMenuEditor)
-test_xlDialogMove (xlDialogMove)
-test_xlDialogMyPermission (xlDialogMyPermission)
-test_xlDialogNew (xlDialogNew)
-test_xlDialogNewWebQuery (xlDialogNewWebQuery)
-test_xlDialogNote (xlDialogNote)
-test_xlDialogObjectProperties (xlDialogObjectProperties)
-test_xlDialogObjectProtection (xlDialogObjectProtection)
-test_xlDialogOpen (xlDialogOpen)
-test_xlDialogOpenLinks (xlDialogOpenLinks)
-test_xlDialogOpenMail (xlDialogOpenMail)
-test_xlDialogOpenText (xlDialogOpenText)
-test_xlDialogOptionsCalculation (xlDialogOptionsCalculation)
-test_xlDialogOptionsChart (xlDialogOptionsChart)
-test_xlDialogOptionsEdit (xlDialogOptionsEdit)
-test_xlDialogOptionsGeneral (xlDialogOptionsGeneral)
-test_xlDialogOptionsListAdd (xlDialogOptionsListAdd)
-test_xlDialogOptionsME (xlDialogOptionsME)
-test_xlDialogOptionsTransition (xlDialogOptionsTransition)
-test_xlDialogOptionsView (xlDialogOptionsView)
-test_xlDialogOutline (xlDialogOutline)
-test_xlDialogOverlay (xlDialogOverlay)
-test_xlDialogOverlayChartType (xlDialogOverlayChartType)
-test_xlDialogPageSetup (xlDialogPageSetup)
-test_xlDialogParse (xlDialogParse)
-test_xlDialogPasteNames (xlDialogPasteNames)
-test_xlDialogPasteSpecial (xlDialogPasteSpecial)
-test_xlDialogPatterns (xlDialogPatterns)
-test_xlDialogPermission (xlDialogPermission)
-test_xlDialogPhonetic (xlDialogPhonetic)
-test_xlDialogPivotCalculatedField (xlDialogPivotCalculatedField)
-test_xlDialogPivotCalculatedItem (xlDialogPivotCalculatedItem)
-test_xlDialogPivotClientServerSet (xlDialogPivotClientServerSet)
-test_xlDialogPivotFieldGroup (xlDialogPivotFieldGroup)
-test_xlDialogPivotFieldProperties (xlDialogPivotFieldProperties)
-test_xlDialogPivotFieldUngroup (xlDialogPivotFieldUngroup)
-test_xlDialogPivotShowPages (xlDialogPivotShowPages)
-test_xlDialogPivotSolveOrder (xlDialogPivotSolveOrder)
-test_xlDialogPivotTableOptions (xlDialogPivotTableOptions)
-test_xlDialogPivotTableWizard (xlDialogPivotTableWizard)
-test_xlDialogPlacement (xlDialogPlacement)
-test_xlDialogPrint (xlDialogPrint)
-test_xlDialogPrintSetup (xlDialogPrintSetup)
-test_xlDialogPrintPreview (xlDialogPrintPreview)
-test_xlDialogPromote (xlDialogPromote)
-test_xlDialogProperties (xlDialogProperties)
-test_xlDialogPropertyFields (xlDialogPropertyFields)
-test_xlDialogProtectDocument (xlDialogProtectDocument)
-test_xlDialogProtectSharing (xlDialogProtectSharing)
-test_xlDialogPublishAsWebPage (xlDialogPublishAsWebPage)
-test_xlDialogPushbuttonProperties (xlDialogPushbuttonProperties)
-test_xlDialogReplaceFont (xlDialogReplaceFont)
-test_xlDialogRoutingSlip (xlDialogRoutingSlip)
-test_xlDialogRowHeight (xlDialogRowHeight)
-test_xlDialogRun (xlDialogRun)
-test_xlDialogSaveAs (xlDialogSaveAs)
-test_xlDialogSaveCopyAs (xlDialogSaveCopyAs)
-test_xlDialogSaveNewObject (xlDialogSaveNewObject)
-test_xlDialogSaveWorkbook (xlDialogSaveWorkbook)
-test_xlDialogSaveWorkspace (xlDialogSaveWorkspace)
-test_xlDialogScale (xlDialogScale)
-test_xlDialogScenarioAdd (xlDialogScenarioAdd)
-test_xlDialogScenarioCells (xlDialogScenarioCells)
-test_xlDialogScenarioEdit (xlDialogScenarioEdit)
-test_xlDialogScenarioMerge (xlDialogScenarioMerge)
-test_xlDialogScenarioSummary (xlDialogScenarioSummary)
-test_xlDialogScrollbarProperties (xlDialogScrollbarProperties)
-test_xlDialogSearch (xlDialogSearch)
-test_xlDialogSelectSpecial (xlDialogSelectSpecial)
-test_xlDialogSendMail (xlDialogSendMail)
-test_xlDialogSeriesAxes (xlDialogSeriesAxes)
-test_xlDialogSeriesOptions (xlDialogSeriesOptions)
-test_xlDialogSeriesOrder (xlDialogSeriesOrder)
-test_xlDialogSeriesShape (xlDialogSeriesShape)
-test_xlDialogSeriesX (xlDialogSeriesX)
-test_xlDialogSeriesY (xlDialogSeriesY)
-test_xlDialogSetBackgroundPicture (xlDialogSetBackgroundPicture)
-test_xlDialogSetPrintTitles (xlDialogSetPrintTitles)
-test_xlDialogSetUpdateStatus (xlDialogSetUpdateStatus)
-test_xlDialogShowDetail (xlDialogShowDetail)
-test_xlDialogShowToolbar (xlDialogShowToolbar)
-test_xlDialogSize (xlDialogSize)
-test_xlDialogSort (xlDialogSort)
-test_xlDialogSortSpecial (xlDialogSortSpecial)
-test_xlDialogSplit (xlDialogSplit)
-test_xlDialogStandardFont (xlDialogStandardFont)
-test_xlDialogStandardWidth (xlDialogStandardWidth)
-test_xlDialogStyle (xlDialogStyle)
-test_xlDialogSubscribeTo (xlDialogSubscribeTo)
-test_xlDialogSubtotalCreate (xlDialogSubtotalCreate)
-test_xlDialogSummaryInfo (xlDialogSummaryInfo)
-test_xlDialogTable (xlDialogTable)
-test_xlDialogTabOrder (xlDialogTabOrder)
-test_xlDialogTextToColumns (xlDialogTextToColumns)
-test_xlDialogUnhide (xlDialogUnhide)
-test_xlDialogUpdateLink (xlDialogUpdateLink)
-test_xlDialogVbaInsertFile (xlDialogVbaInsertFile)
-test_xlDialogVbaMakeAddin (xlDialogVbaMakeAddin)
-test_xlDialogVbaProcedureDefinition (xlDialogVbaProcedureDefinition)
-test_xlDialogView3d (xlDialogView3d)
-test_xlDialogWebOptionsBrowsers (xlDialogWebOptionsBrowsers)
-test_xlDialogWebOptionsEncoding (xlDialogWebOptionsEncoding)
-test_xlDialogWebOptionsFiles (xlDialogWebOptionsFiles)
-test_xlDialogWebOptionsFonts (xlDialogWebOptionsFonts)
-test_xlDialogWebOptionsGeneral (xlDialogWebOptionsGeneral)
-test_xlDialogWebOptionsPictures (xlDialogWebOptionsPictures)
-test_xlDialogWindowMove (xlDialogWindowMove)
-test_xlDialogWindowSize (xlDialogWindowSize)
-test_xlDialogWorkbookAdd (xlDialogWorkbookAdd)
-test_xlDialogWorkbookCopy (xlDialogWorkbookCopy)
-test_xlDialogWorkbookInsert (xlDialogWorkbookInsert)
-test_xlDialogWorkbookMove (xlDialogWorkbookMove)
-test_xlDialogWorkbookName (xlDialogWorkbookName)
-test_xlDialogWorkbookNew (xlDialogWorkbookNew)
-test_xlDialogWorkbookOptions (xlDialogWorkbookOptions)
-test_xlDialogWorkbookProtect (xlDialogWorkbookProtect)
-test_xlDialogWorkbookTabSplit (xlDialogWorkbookTabSplit)
-test_xlDialogWorkbookUnhide (xlDialogWorkbookUnhide)
-test_xlDialogWorkgroup (xlDialogWorkgroup)
-test_xlDialogWorkspace (xlDialogWorkspace)
-test_xlDialogZoom (xlDialogZoom)
-Range("A1").Value = "constant name"
-Range("B1").Value = "OOo result"
-Range("C1").Value = "Excel result"
-Range("D1").Value = "Correct?"
-End Sub
-
-Function test_xlDialogActivate(ByRef num)
-Range("A2").Clear
-Range("B2").Clear
-Range("C2").Clear
-Range("D2").Clear
-Range("A2").Value = "xlDialogActivate"
-Range("B2").Value = 103
-Range("C2").Value = num
-B2 = Range("B2").Value
-C2 = Range("C2").Value
-If B2 = C2 Then
-Range("D2").Value = "OK"
-Else
-Range("D2").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogActiveCellFont(ByRef num)
-Range("A3").Clear
-Range("B3").Clear
-Range("C3").Clear
-Range("D3").Clear
-Range("A3").Value = "xlDialogActiveCellFont"
-Range("B3").Value = 476
-Range("C3").Value = num
-B3 = Range("B3").Value
-C3 = Range("C3").Value
-If B3 = C3 Then
-Range("D3").Value = "OK"
-Else
-Range("D3").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAddChartAutoformat(ByRef num)
-Range("A4").Clear
-Range("B4").Clear
-Range("C4").Clear
-Range("D4").Clear
-Range("A4").Value = "xlDialogAddChartAutoformat"
-Range("B4").Value = 390
-Range("C4").Value = num
-B4 = Range("B4").Value
-C4 = Range("C4").Value
-If B4 = C4 Then
-Range("D4").Value = "OK"
-Else
-Range("D4").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAddinManager(ByRef num)
-Range("A5").Clear
-Range("B5").Clear
-Range("C5").Clear
-Range("D5").Clear
-Range("A5").Value = "xlDialogAddinManager"
-Range("B5").Value = 321
-Range("C5").Value = num
-B5 = Range("B5").Value
-C5 = Range("C5").Value
-If B5 = C5 Then
-Range("D5").Value = "OK"
-Else
-Range("D5").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAlignment(ByRef num)
-Range("A6").Clear
-Range("B6").Clear
-Range("C6").Clear
-Range("D6").Clear
-Range("A6").Value = "xlDialogAlignment"
-Range("B6").Value = 43
-Range("C6").Value = num
-B6 = Range("B6").Value
-C6 = Range("C6").Value
-If B6 = C6 Then
-Range("D6").Value = "OK"
-Else
-Range("D6").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogApplyNames(ByRef num)
-Range("A7").Clear
-Range("B7").Clear
-Range("C7").Clear
-Range("D7").Clear
-Range("A7").Value = "xlDialogApplyNames"
-Range("B7").Value = 133
-Range("C7").Value = num
-B7 = Range("B7").Value
-C7 = Range("C7").Value
-If B7 = C7 Then
-Range("D7").Value = "OK"
-Else
-Range("D7").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogApplyStyle(ByRef num)
-Range("A8").Clear
-Range("B8").Clear
-Range("C8").Clear
-Range("D8").Clear
-Range("A8").Value = "xlDialogApplyStyle"
-Range("B8").Value = 212
-Range("C8").Value = num
-B8 = Range("B8").Value
-C8 = Range("C8").Value
-If B8 = C8 Then
-Range("D8").Value = "OK"
-Else
-Range("D8").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAppMove(ByRef num)
-Range("A9").Clear
-Range("B9").Clear
-Range("C9").Clear
-Range("D9").Clear
-Range("A9").Value = "xlDialogAppMove"
-Range("B9").Value = 170
-Range("C9").Value = num
-B9 = Range("B9").Value
-C9 = Range("C9").Value
-If B9 = C9 Then
-Range("D9").Value = "OK"
-Else
-Range("D9").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAppSize(ByRef num)
-Range("A10").Clear
-Range("B10").Clear
-Range("C10").Clear
-Range("D10").Clear
-Range("A10").Value = "xlDialogAppSize"
-Range("B10").Value = 171
-Range("C10").Value = num
-B10 = Range("B10").Value
-C10 = Range("C10").Value
-If B10 = C10 Then
-Range("D10").Value = "OK"
-Else
-Range("D10").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogArrangeAll(ByRef num)
-Range("A11").Clear
-Range("B11").Clear
-Range("C11").Clear
-Range("D11").Clear
-Range("A11").Value = "xlDialogArrangeAll"
-Range("B11").Value = 12
-Range("C11").Value = num
-B11 = Range("B11").Value
-C11 = Range("C11").Value
-If B11 = C11 Then
-Range("D11").Value = "OK"
-Else
-Range("D11").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAssignToObject(ByRef num)
-Range("A12").Clear
-Range("B12").Clear
-Range("C12").Clear
-Range("D12").Clear
-Range("A12").Value = "xlDialogAssignToObject"
-Range("B12").Value = 213
-Range("C12").Value = num
-B12 = Range("B12").Value
-C12 = Range("C12").Value
-If B12 = C12 Then
-Range("D12").Value = "OK"
-Else
-Range("D12").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAssignToTool(ByRef num)
-Range("A13").Clear
-Range("B13").Clear
-Range("C13").Clear
-Range("D13").Clear
-Range("A13").Value = "xlDialogAssignToTool"
-Range("B13").Value = 293
-Range("C13").Value = num
-B13 = Range("B13").Value
-C13 = Range("C13").Value
-If B13 = C13 Then
-Range("D13").Value = "OK"
-Else
-Range("D13").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAttachText(ByRef num)
-Range("A14").Clear
-Range("B14").Clear
-Range("C14").Clear
-Range("D14").Clear
-Range("A14").Value = "xlDialogAttachText"
-Range("B14").Value = 80
-Range("C14").Value = num
-B14 = Range("B14").Value
-C14 = Range("C14").Value
-If B14 = C14 Then
-Range("D14").Value = "OK"
-Else
-Range("D14").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAttachToolbars(ByRef num)
-Range("A15").Clear
-Range("B15").Clear
-Range("C15").Clear
-Range("D15").Clear
-Range("A15").Value = "xlDialogAttachToolbars"
-Range("B15").Value = 323
-Range("C15").Value = num
-B15 = Range("B15").Value
-C15 = Range("C15").Value
-If B15 = C15 Then
-Range("D15").Value = "OK"
-Else
-Range("D15").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAutoCorrect(ByRef num)
-Range("A16").Clear
-Range("B16").Clear
-Range("C16").Clear
-Range("D16").Clear
-Range("A16").Value = "xlDialogAutoCorrect"
-Range("B16").Value = 485
-Range("C16").Value = num
-B16 = Range("B16").Value
-C16 = Range("C16").Value
-If B16 = C16 Then
-Range("D16").Value = "OK"
-Else
-Range("D16").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogAxes(ByRef num)
-Range("A17").Clear
-Range("B17").Clear
-Range("C17").Clear
-Range("D17").Clear
-Range("A17").Value = "xlDialogAxes"
-Range("B17").Value = 78
-Range("C17").Value = num
-B17 = Range("B17").Value
-C17 = Range("C17").Value
-If B17 = C17 Then
-Range("D17").Value = "OK"
-Else
-Range("D17").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogBorder(ByRef num)
-Range("A18").Clear
-Range("B18").Clear
-Range("C18").Clear
-Range("D18").Clear
-Range("A18").Value = "xlDialogBorder"
-Range("B18").Value = 45
-Range("C18").Value = num
-B18 = Range("B18").Value
-C18 = Range("C18").Value
-If B18 = C18 Then
-Range("D18").Value = "OK"
-Else
-Range("D18").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCalculation(ByRef num)
-Range("A19").Clear
-Range("B19").Clear
-Range("C19").Clear
-Range("D19").Clear
-Range("A19").Value = "xlDialogCalculation"
-Range("B19").Value = 32
-Range("C19").Value = num
-B19 = Range("B19").Value
-C19 = Range("C19").Value
-If B19 = C19 Then
-Range("D19").Value = "OK"
-Else
-Range("D19").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCellProtection(ByRef num)
-Range("A20").Clear
-Range("B20").Clear
-Range("C20").Clear
-Range("D20").Clear
-Range("A20").Value = "xlDialogCellProtection"
-Range("B20").Value = 46
-Range("C20").Value = num
-B20 = Range("B20").Value
-C20 = Range("C20").Value
-If B20 = C20 Then
-Range("D20").Value = "OK"
-Else
-Range("D20").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChangeLink(ByRef num)
-Range("A21").Clear
-Range("B21").Clear
-Range("C21").Clear
-Range("D21").Clear
-Range("A21").Value = "xlDialogChangeLink"
-Range("B21").Value = 166
-Range("C21").Value = num
-B21 = Range("B21").Value
-C21 = Range("C21").Value
-If B21 = C21 Then
-Range("D21").Value = "OK"
-Else
-Range("D21").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartAddData(ByRef num)
-Range("A22").Clear
-Range("B22").Clear
-Range("C22").Clear
-Range("D22").Clear
-Range("A22").Value = "xlDialogChartAddData"
-Range("B22").Value = 392
-Range("C22").Value = num
-B22 = Range("B22").Value
-C22 = Range("C22").Value
-If B22 = C22 Then
-Range("D22").Value = "OK"
-Else
-Range("D22").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartLocation(ByRef num)
-Range("A23").Clear
-Range("B23").Clear
-Range("C23").Clear
-Range("D23").Clear
-Range("A23").Value = "xlDialogChartLocation"
-Range("B23").Value = 527
-Range("C23").Value = num
-B23 = Range("B23").Value
-C23 = Range("C23").Value
-If B23 = C23 Then
-Range("D23").Value = "OK"
-Else
-Range("D23").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartOptionDataLabelMultiple(ByRef num)
-Range("A24").Clear
-Range("B24").Clear
-Range("C24").Clear
-Range("D24").Clear
-Range("A24").Value = "xlDialogChartOptionDataLabelMultiple"
-Range("B24").Value = 724
-Range("C24").Value = num
-B24 = Range("B24").Value
-C24 = Range("C24").Value
-If B24 = C24 Then
-Range("D24").Value = "OK"
-Else
-Range("D24").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartOptionDataLabels(ByRef num)
-Range("A25").Clear
-Range("B25").Clear
-Range("C25").Clear
-Range("D25").Clear
-Range("A25").Value = "xlDialogChartOptionDataLabels"
-Range("B25").Value = 505
-Range("C25").Value = num
-B25 = Range("B25").Value
-C25 = Range("C25").Value
-If B25 = C25 Then
-Range("D25").Value = "OK"
-Else
-Range("D25").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartOptionDataTable(ByRef num)
-Range("A26").Clear
-Range("B26").Clear
-Range("C26").Clear
-Range("D26").Clear
-Range("A26").Value = "xlDialogChartOptionDataTable"
-Range("B26").Value = 506
-Range("C26").Value = num
-B26 = Range("B26").Value
-C26 = Range("C26").Value
-If B26 = C26 Then
-Range("D26").Value = "OK"
-Else
-Range("D26").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartSourceData(ByRef num)
-Range("A27").Clear
-Range("B27").Clear
-Range("C27").Clear
-Range("D27").Clear
-Range("A27").Value = "xlDialogChartSourceData"
-Range("B27").Value = 540
-Range("C27").Value = num
-B27 = Range("B27").Value
-C27 = Range("C27").Value
-If B27 = C27 Then
-Range("D27").Value = "OK"
-Else
-Range("D27").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartTrend(ByRef num)
-Range("A28").Clear
-Range("B28").Clear
-Range("C28").Clear
-Range("D28").Clear
-Range("A28").Value = "xlDialogChartTrend"
-Range("B28").Value = 350
-Range("C28").Value = num
-B28 = Range("B28").Value
-C28 = Range("C28").Value
-If B28 = C28 Then
-Range("D28").Value = "OK"
-Else
-Range("D28").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartType(ByRef num)
-Range("A29").Clear
-Range("B29").Clear
-Range("C29").Clear
-Range("D29").Clear
-Range("A29").Value = "xlDialogChartType"
-Range("B29").Value = 526
-Range("C29").Value = num
-B29 = Range("B29").Value
-C29 = Range("C29").Value
-If B29 = C29 Then
-Range("D29").Value = "OK"
-Else
-Range("D29").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChartWizard(ByRef num)
-Range("A30").Clear
-Range("B30").Clear
-Range("C30").Clear
-Range("D30").Clear
-Range("A30").Value = "xlDialogChartWizard"
-Range("B30").Value = 288
-Range("C30").Value = num
-B30 = Range("B30").Value
-C30 = Range("C30").Value
-If B30 = C30 Then
-Range("D30").Value = "OK"
-Else
-Range("D30").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogChechboxProperties(ByRef num)
-Range("A31").Clear
-Range("B31").Clear
-Range("C31").Clear
-Range("D31").Clear
-Range("A31").Value = "xlDialogChechboxProperties"
-Range("B31").Value = 435
-Range("C31").Value = num
-B31 = Range("B31").Value
-C31 = Range("C31").Value
-If B31 = C31 Then
-Range("D31").Value = "OK"
-Else
-Range("D31").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogClear(ByRef num)
-Range("A32").Clear
-Range("B32").Clear
-Range("C32").Clear
-Range("D32").Clear
-Range("A32").Value = "xlDialogClear"
-Range("B32").Value = 52
-Range("C32").Value = num
-B32 = Range("B32").Value
-C32 = Range("C32").Value
-If B32 = C32 Then
-Range("D32").Value = "OK"
-Else
-Range("D32").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogColorPalette(ByRef num)
-Range("A33").Clear
-Range("B33").Clear
-Range("C33").Clear
-Range("D33").Clear
-Range("A33").Value = "xlDialogColorPalette"
-Range("B33").Value = 161
-Range("C33").Value = num
-B33 = Range("B33").Value
-C33 = Range("C33").Value
-If B33 = C33 Then
-Range("D33").Value = "OK"
-Else
-Range("D33").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogColumnWidth(ByRef num)
-Range("A34").Clear
-Range("B34").Clear
-Range("C34").Clear
-Range("D34").Clear
-Range("A34").Value = "xlDialogColumnWidth"
-Range("B34").Value = 47
-Range("C34").Value = num
-B34 = Range("B34").Value
-C34 = Range("C34").Value
-If B34 = C34 Then
-Range("D34").Value = "OK"
-Else
-Range("D34").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCombination(ByRef num)
-Range("A35").Clear
-Range("B35").Clear
-Range("C35").Clear
-Range("D35").Clear
-Range("A35").Value = "xlDialogCombination"
-Range("B35").Value = 73
-Range("C35").Value = num
-B35 = Range("B35").Value
-C35 = Range("C35").Value
-If B35 = C35 Then
-Range("D35").Value = "OK"
-Else
-Range("D35").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogConditionalFormatting(ByRef num)
-Range("A36").Clear
-Range("B36").Clear
-Range("C36").Clear
-Range("D36").Clear
-Range("A36").Value = "xlDialogConditionalFormatting"
-Range("B36").Value = 583
-Range("C36").Value = num
-B36 = Range("B36").Value
-C36 = Range("C36").Value
-If B36 = C36 Then
-Range("D36").Value = "OK"
-Else
-Range("D36").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogConsolidate(ByRef num)
-Range("A37").Clear
-Range("B37").Clear
-Range("C37").Clear
-Range("D37").Clear
-Range("A37").Value = "xlDialogConsolidate"
-Range("B37").Value = 191
-Range("C37").Value = num
-B37 = Range("B37").Value
-C37 = Range("C37").Value
-If B37 = C37 Then
-Range("D37").Value = "OK"
-Else
-Range("D37").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCopyChart(ByRef num)
-Range("A38").Clear
-Range("B38").Clear
-Range("C38").Clear
-Range("D38").Clear
-Range("A38").Value = "xlDialogCopyChart"
-Range("B38").Value = 147
-Range("C38").Value = num
-B38 = Range("B38").Value
-C38 = Range("C38").Value
-If B38 = C38 Then
-Range("D38").Value = "OK"
-Else
-Range("D38").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCopyPicture(ByRef num)
-Range("A39").Clear
-Range("B39").Clear
-Range("C39").Clear
-Range("D39").Clear
-Range("A39").Value = "xlDialogCopyPicture"
-Range("B39").Value = 108
-Range("C39").Value = num
-B39 = Range("B39").Value
-C39 = Range("C39").Value
-If B39 = C39 Then
-Range("D39").Value = "OK"
-Else
-Range("D39").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCreateList(ByRef num)
-Range("A40").Clear
-Range("B40").Clear
-Range("C40").Clear
-Range("D40").Clear
-Range("A40").Value = "xlDialogCreateList"
-Range("B40").Value = 769
-Range("C40").Value = num
-B40 = Range("B40").Value
-C40 = Range("C40").Value
-If B40 = C40 Then
-Range("D40").Value = "OK"
-Else
-Range("D40").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCreateNames(ByRef num)
-Range("A41").Clear
-Range("B41").Clear
-Range("C41").Clear
-Range("D41").Clear
-Range("A41").Value = "xlDialogCreateNames"
-Range("B41").Value = 62
-Range("C41").Value = num
-B41 = Range("B41").Value
-C41 = Range("C41").Value
-If B41 = C41 Then
-Range("D41").Value = "OK"
-Else
-Range("D41").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCreatePublisher(ByRef num)
-Range("A42").Clear
-Range("B42").Clear
-Range("C42").Clear
-Range("D42").Clear
-Range("A42").Value = "xlDialogCreatePublisher"
-Range("B42").Value = 217
-Range("C42").Value = num
-B42 = Range("B42").Value
-C42 = Range("C42").Value
-If B42 = C42 Then
-Range("D42").Value = "OK"
-Else
-Range("D42").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCustomizeToolbar(ByRef num)
-Range("A43").Clear
-Range("B43").Clear
-Range("C43").Clear
-Range("D43").Clear
-Range("A43").Value = "xlDialogCustomizeToolbar"
-Range("B43").Value = 276
-Range("C43").Value = num
-B43 = Range("B43").Value
-C43 = Range("C43").Value
-If B43 = C43 Then
-Range("D43").Value = "OK"
-Else
-Range("D43").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogCustomViews(ByRef num)
-Range("A44").Clear
-Range("B44").Clear
-Range("C44").Clear
-Range("D44").Clear
-Range("A44").Value = "xlDialogCustomViews"
-Range("B44").Value = 493
-Range("C44").Value = num
-B44 = Range("B44").Value
-C44 = Range("C44").Value
-If B44 = C44 Then
-Range("D44").Value = "OK"
-Else
-Range("D44").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDataDelete(ByRef num)
-Range("A45").Clear
-Range("B45").Clear
-Range("C45").Clear
-Range("D45").Clear
-Range("A45").Value = "xlDialogDataDelete"
-Range("B45").Value = 36
-Range("C45").Value = num
-B45 = Range("B45").Value
-C45 = Range("C45").Value
-If B45 = C45 Then
-Range("D45").Value = "OK"
-Else
-Range("D45").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDataLabel(ByRef num)
-Range("A46").Clear
-Range("B46").Clear
-Range("C46").Clear
-Range("D46").Clear
-Range("A46").Value = "xlDialogDataLabel"
-Range("B46").Value = 379
-Range("C46").Value = num
-B46 = Range("B46").Value
-C46 = Range("C46").Value
-If B46 = C46 Then
-Range("D46").Value = "OK"
-Else
-Range("D46").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDataLabelMultiple(ByRef num)
-Range("A47").Clear
-Range("B47").Clear
-Range("C47").Clear
-Range("D47").Clear
-Range("A47").Value = "xlDialogDataLabelMultiple"
-Range("B47").Value = 723
-Range("C47").Value = num
-B47 = Range("B47").Value
-C47 = Range("C47").Value
-If B47 = C47 Then
-Range("D47").Value = "OK"
-Else
-Range("D47").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDataSeries(ByRef num)
-Range("A48").Clear
-Range("B48").Clear
-Range("C48").Clear
-Range("D48").Clear
-Range("A48").Value = "xlDialogDataSeries"
-Range("B48").Value = 40
-Range("C48").Value = num
-B48 = Range("B48").Value
-C48 = Range("C48").Value
-If B48 = C48 Then
-Range("D48").Value = "OK"
-Else
-Range("D48").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDataValidation(ByRef num)
-Range("A49").Clear
-Range("B49").Clear
-Range("C49").Clear
-Range("D49").Clear
-Range("A49").Value = "xlDialogDataValidation"
-Range("B49").Value = 525
-Range("C49").Value = num
-B49 = Range("B49").Value
-C49 = Range("C49").Value
-If B49 = C49 Then
-Range("D49").Value = "OK"
-Else
-Range("D49").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDefineName(ByRef num)
-Range("A50").Clear
-Range("B50").Clear
-Range("C50").Clear
-Range("D50").Clear
-Range("A50").Value = "xlDialogDefineName"
-Range("B50").Value = 61
-Range("C50").Value = num
-B50 = Range("B50").Value
-C50 = Range("C50").Value
-If B50 = C50 Then
-Range("D50").Value = "OK"
-Else
-Range("D50").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDefineStyle(ByRef num)
-Range("A51").Clear
-Range("B51").Clear
-Range("C51").Clear
-Range("D51").Clear
-Range("A51").Value = "xlDialogDefineStyle"
-Range("B51").Value = 229
-Range("C51").Value = num
-B51 = Range("B51").Value
-C51 = Range("C51").Value
-If B51 = C51 Then
-Range("D51").Value = "OK"
-Else
-Range("D51").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDeleteFormat(ByRef num)
-Range("A52").Clear
-Range("B52").Clear
-Range("C52").Clear
-Range("D52").Clear
-Range("A52").Value = "xlDialogDeleteFormat"
-Range("B52").Value = 111
-Range("C52").Value = num
-B52 = Range("B52").Value
-C52 = Range("C52").Value
-If B52 = C52 Then
-Range("D52").Value = "OK"
-Else
-Range("D52").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDeleteName(ByRef num)
-Range("A53").Clear
-Range("B53").Clear
-Range("C53").Clear
-Range("D53").Clear
-Range("A53").Value = "xlDialogDeleteName"
-Range("B53").Value = 110
-Range("C53").Value = num
-B53 = Range("B53").Value
-C53 = Range("C53").Value
-If B53 = C53 Then
-Range("D53").Value = "OK"
-Else
-Range("D53").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDemote(ByRef num)
-Range("A54").Clear
-Range("B54").Clear
-Range("C54").Clear
-Range("D54").Clear
-Range("A54").Value = "xlDialogDemote"
-Range("B54").Value = 203
-Range("C54").Value = num
-B54 = Range("B54").Value
-C54 = Range("C54").Value
-If B54 = C54 Then
-Range("D54").Value = "OK"
-Else
-Range("D54").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogDisplay(ByRef num)
-Range("A55").Clear
-Range("B55").Clear
-Range("C55").Clear
-Range("D55").Clear
-Range("A55").Value = "xlDialogDisplay"
-Range("B55").Value = 27
-Range("C55").Value = num
-B55 = Range("B55").Value
-C55 = Range("C55").Value
-If B55 = C55 Then
-Range("D55").Value = "OK"
-Else
-Range("D55").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEditboxProperties(ByRef num)
-Range("A56").Clear
-Range("B56").Clear
-Range("C56").Clear
-Range("D56").Clear
-Range("A56").Value = "xlDialogEditboxProperties"
-Range("B56").Value = 438
-Range("C56").Value = num
-B56 = Range("B56").Value
-C56 = Range("C56").Value
-If B56 = C56 Then
-Range("D56").Value = "OK"
-Else
-Range("D56").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEditColor(ByRef num)
-Range("A57").Clear
-Range("B57").Clear
-Range("C57").Clear
-Range("D57").Clear
-Range("A57").Value = "xlDialogEditColor"
-Range("B57").Value = 223
-Range("C57").Value = num
-B57 = Range("B57").Value
-C57 = Range("C57").Value
-If B57 = C57 Then
-Range("D57").Value = "OK"
-Else
-Range("D57").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEditDelete(ByRef num)
-Range("A58").Clear
-Range("B58").Clear
-Range("C58").Clear
-Range("D58").Clear
-Range("A58").Value = "xlDialogEditDelete"
-Range("B58").Value = 54
-Range("C58").Value = num
-B58 = Range("B58").Value
-C58 = Range("C58").Value
-If B58 = C58 Then
-Range("D58").Value = "OK"
-Else
-Range("D58").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEditionOptions(ByRef num)
-Range("A59").Clear
-Range("B59").Clear
-Range("C59").Clear
-Range("D59").Clear
-Range("A59").Value = "xlDialogEditionOptions"
-Range("B59").Value = 251
-Range("C59").Value = num
-B59 = Range("B59").Value
-C59 = Range("C59").Value
-If B59 = C59 Then
-Range("D59").Value = "OK"
-Else
-Range("D59").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEditSeries(ByRef num)
-Range("A60").Clear
-Range("B60").Clear
-Range("C60").Clear
-Range("D60").Clear
-Range("A60").Value = "xlDialogEditSeries"
-Range("B60").Value = 228
-Range("C60").Value = num
-B60 = Range("B60").Value
-C60 = Range("C60").Value
-If B60 = C60 Then
-Range("D60").Value = "OK"
-Else
-Range("D60").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogErrorbarX(ByRef num)
-Range("A61").Clear
-Range("B61").Clear
-Range("C61").Clear
-Range("D61").Clear
-Range("A61").Value = "xlDialogErrorbarX"
-Range("B61").Value = 463
-Range("C61").Value = num
-B61 = Range("B61").Value
-C61 = Range("C61").Value
-If B61 = C61 Then
-Range("D61").Value = "OK"
-Else
-Range("D61").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogErrorbarY(ByRef num)
-Range("A62").Clear
-Range("B62").Clear
-Range("C62").Clear
-Range("D62").Clear
-Range("A62").Value = "xlDialogErrorbarY"
-Range("B62").Value = 464
-Range("C62").Value = num
-B62 = Range("B62").Value
-C62 = Range("C62").Value
-If B62 = C62 Then
-Range("D62").Value = "OK"
-Else
-Range("D62").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogErrorChecking(ByRef num)
-Range("A63").Clear
-Range("B63").Clear
-Range("C63").Clear
-Range("D63").Clear
-Range("A63").Value = "xlDialogErrorChecking"
-Range("B63").Value = 732
-Range("C63").Value = num
-B63 = Range("B63").Value
-C63 = Range("C63").Value
-If B63 = C63 Then
-Range("D63").Value = "OK"
-Else
-Range("D63").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogEvaluateFormula(ByRef num)
-Range("A64").Clear
-Range("B64").Clear
-Range("C64").Clear
-Range("D64").Clear
-Range("A64").Value = "xlDialogEvaluateFormula"
-Range("B64").Value = 709
-Range("C64").Value = num
-B64 = Range("B64").Value
-C64 = Range("C64").Value
-If B64 = C64 Then
-Range("D64").Value = "OK"
-Else
-Range("D64").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogExternalDataProperties(ByRef num)
-Range("A65").Clear
-Range("B65").Clear
-Range("C65").Clear
-Range("D65").Clear
-Range("A65").Value = "xlDialogExternalDataProperties"
-Range("B65").Value = 530
-Range("C65").Value = num
-B65 = Range("B65").Value
-C65 = Range("C65").Value
-If B65 = C65 Then
-Range("D65").Value = "OK"
-Else
-Range("D65").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogExtract(ByRef num)
-Range("A66").Clear
-Range("B66").Clear
-Range("C66").Clear
-Range("D66").Clear
-Range("A66").Value = "xlDialogExtract"
-Range("B66").Value = 35
-Range("C66").Value = num
-B66 = Range("B66").Value
-C66 = Range("C66").Value
-If B66 = C66 Then
-Range("D66").Value = "OK"
-Else
-Range("D66").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFileDelete(ByRef num)
-Range("A67").Clear
-Range("B67").Clear
-Range("C67").Clear
-Range("D67").Clear
-Range("A67").Value = "xlDialogFileDelete"
-Range("B67").Value = 6
-Range("C67").Value = num
-B67 = Range("B67").Value
-C67 = Range("C67").Value
-If B67 = C67 Then
-Range("D67").Value = "OK"
-Else
-Range("D67").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFileSharing(ByRef num)
-Range("A68").Clear
-Range("B68").Clear
-Range("C68").Clear
-Range("D68").Clear
-Range("A68").Value = "xlDialogFileSharing"
-Range("B68").Value = 481
-Range("C68").Value = num
-B68 = Range("B68").Value
-C68 = Range("C68").Value
-If B68 = C68 Then
-Range("D68").Value = "OK"
-Else
-Range("D68").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFillGroup(ByRef num)
-Range("A69").Clear
-Range("B69").Clear
-Range("C69").Clear
-Range("D69").Clear
-Range("A69").Value = "xlDialogFillGroup"
-Range("B69").Value = 200
-Range("C69").Value = num
-B69 = Range("B69").Value
-C69 = Range("C69").Value
-If B69 = C69 Then
-Range("D69").Value = "OK"
-Else
-Range("D69").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFillWorkGroup(ByRef num)
-Range("A70").Clear
-Range("B70").Clear
-Range("C70").Clear
-Range("D70").Clear
-Range("A70").Value = "xlDialogFillWorkGroup"
-Range("B70").Value = 301
-Range("C70").Value = num
-B70 = Range("B70").Value
-C70 = Range("C70").Value
-If B70 = C70 Then
-Range("D70").Value = "OK"
-Else
-Range("D70").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFilter(ByRef num)
-Range("A71").Clear
-Range("B71").Clear
-Range("C71").Clear
-Range("D71").Clear
-Range("A71").Value = "xlDialogFilter"
-Range("B71").Value = 447
-Range("C71").Value = num
-B71 = Range("B71").Value
-C71 = Range("C71").Value
-If B71 = C71 Then
-Range("D71").Value = "OK"
-Else
-Range("D71").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFilterAdvanced(ByRef num)
-Range("A72").Clear
-Range("B72").Clear
-Range("C72").Clear
-Range("D72").Clear
-Range("A72").Value = "xlDialogFilterAdvanced"
-Range("B72").Value = 370
-Range("C72").Value = num
-B72 = Range("B72").Value
-C72 = Range("C72").Value
-If B72 = C72 Then
-Range("D72").Value = "OK"
-Else
-Range("D72").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFindFile(ByRef num)
-Range("A73").Clear
-Range("B73").Clear
-Range("C73").Clear
-Range("D73").Clear
-Range("A73").Value = "xlDialogFindFile"
-Range("B73").Value = 475
-Range("C73").Value = num
-B73 = Range("B73").Value
-C73 = Range("C73").Value
-If B73 = C73 Then
-Range("D73").Value = "OK"
-Else
-Range("D73").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFont(ByRef num)
-Range("A74").Clear
-Range("B74").Clear
-Range("C74").Clear
-Range("D74").Clear
-Range("A74").Value = "xlDialogFont"
-Range("B74").Value = 26
-Range("C74").Value = num
-B74 = Range("B74").Value
-C74 = Range("C74").Value
-If B74 = C74 Then
-Range("D74").Value = "OK"
-Else
-Range("D74").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFontProperties(ByRef num)
-Range("A75").Clear
-Range("B75").Clear
-Range("C75").Clear
-Range("D75").Clear
-Range("A75").Value = "xlDialogFontProperties"
-Range("B75").Value = 381
-Range("C75").Value = num
-B75 = Range("B75").Value
-C75 = Range("C75").Value
-If B75 = C75 Then
-Range("D75").Value = "OK"
-Else
-Range("D75").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatAuto(ByRef num)
-Range("A76").Clear
-Range("B76").Clear
-Range("C76").Clear
-Range("D76").Clear
-Range("A76").Value = "xlDialogFormatAuto"
-Range("B76").Value = 269
-Range("C76").Value = num
-B76 = Range("B76").Value
-C76 = Range("C76").Value
-If B76 = C76 Then
-Range("D76").Value = "OK"
-Else
-Range("D76").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatChart(ByRef num)
-Range("A77").Clear
-Range("B77").Clear
-Range("C77").Clear
-Range("D77").Clear
-Range("A77").Value = "xlDialogFormatChart"
-Range("B77").Value = 465
-Range("C77").Value = num
-B77 = Range("B77").Value
-C77 = Range("C77").Value
-If B77 = C77 Then
-Range("D77").Value = "OK"
-Else
-Range("D77").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatCharttype(ByRef num)
-Range("A78").Clear
-Range("B78").Clear
-Range("C78").Clear
-Range("D78").Clear
-Range("A78").Value = "xlDialogFormatCharttype"
-Range("B78").Value = 423
-Range("C78").Value = num
-B78 = Range("B78").Value
-C78 = Range("C78").Value
-If B78 = C78 Then
-Range("D78").Value = "OK"
-Else
-Range("D78").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatFont(ByRef num)
-Range("A79").Clear
-Range("B79").Clear
-Range("C79").Clear
-Range("D79").Clear
-Range("A79").Value = "xlDialogFormatFont"
-Range("B79").Value = 150
-Range("C79").Value = num
-B79 = Range("B79").Value
-C79 = Range("C79").Value
-If B79 = C79 Then
-Range("D79").Value = "OK"
-Else
-Range("D79").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatLegend(ByRef num)
-Range("A80").Clear
-Range("B80").Clear
-Range("C80").Clear
-Range("D80").Clear
-Range("A80").Value = "xlDialogFormatLegend"
-Range("B80").Value = 88
-Range("C80").Value = num
-B80 = Range("B80").Value
-C80 = Range("C80").Value
-If B80 = C80 Then
-Range("D80").Value = "OK"
-Else
-Range("D80").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatMain(ByRef num)
-Range("A81").Clear
-Range("B81").Clear
-Range("C81").Clear
-Range("D81").Clear
-Range("A81").Value = "xlDialogFormatMain"
-Range("B81").Value = 225
-Range("C81").Value = num
-B81 = Range("B81").Value
-C81 = Range("C81").Value
-If B81 = C81 Then
-Range("D81").Value = "OK"
-Else
-Range("D81").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatMove(ByRef num)
-Range("A82").Clear
-Range("B82").Clear
-Range("C82").Clear
-Range("D82").Clear
-Range("A82").Value = "xlDialogFormatMove"
-Range("B82").Value = 128
-Range("C82").Value = num
-B82 = Range("B82").Value
-C82 = Range("C82").Value
-If B82 = C82 Then
-Range("D82").Value = "OK"
-Else
-Range("D82").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatNumber(ByRef num)
-Range("A83").Clear
-Range("B83").Clear
-Range("C83").Clear
-Range("D83").Clear
-Range("A83").Value = "xlDialogFormatNumber"
-Range("B83").Value = 42
-Range("C83").Value = num
-B83 = Range("B83").Value
-C83 = Range("C83").Value
-If B83 = C83 Then
-Range("D83").Value = "OK"
-Else
-Range("D83").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatOverlay(ByRef num)
-Range("A84").Clear
-Range("B84").Clear
-Range("C84").Clear
-Range("D84").Clear
-Range("A84").Value = "xlDialogFormatOverlay"
-Range("B84").Value = 226
-Range("C84").Value = num
-B84 = Range("B84").Value
-C84 = Range("C84").Value
-If B84 = C84 Then
-Range("D84").Value = "OK"
-Else
-Range("D84").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatSize(ByRef num)
-Range("A85").Clear
-Range("B85").Clear
-Range("C85").Clear
-Range("D85").Clear
-Range("A85").Value = "xlDialogFormatSize"
-Range("B85").Value = 129
-Range("C85").Value = num
-B85 = Range("B85").Value
-C85 = Range("C85").Value
-If B85 = C85 Then
-Range("D85").Value = "OK"
-Else
-Range("D85").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormatText(ByRef num)
-Range("A86").Clear
-Range("B86").Clear
-Range("C86").Clear
-Range("D86").Clear
-Range("A86").Value = "xlDialogFormatText"
-Range("B86").Value = 89
-Range("C86").Value = num
-B86 = Range("B86").Value
-C86 = Range("C86").Value
-If B86 = C86 Then
-Range("D86").Value = "OK"
-Else
-Range("D86").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormulaFind(ByRef num)
-Range("A87").Clear
-Range("B87").Clear
-Range("C87").Clear
-Range("D87").Clear
-Range("A87").Value = "xlDialogFormulaFind"
-Range("B87").Value = 64
-Range("C87").Value = num
-B87 = Range("B87").Value
-C87 = Range("C87").Value
-If B87 = C87 Then
-Range("D87").Value = "OK"
-Else
-Range("D87").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormulaGoto(ByRef num)
-Range("A88").Clear
-Range("B88").Clear
-Range("C88").Clear
-Range("D88").Clear
-Range("A88").Value = "xlDialogFormulaGoto"
-Range("B88").Value = 63
-Range("C88").Value = num
-B88 = Range("B88").Value
-C88 = Range("C88").Value
-If B88 = C88 Then
-Range("D88").Value = "OK"
-Else
-Range("D88").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFormulaReplace(ByRef num)
-Range("A89").Clear
-Range("B89").Clear
-Range("C89").Clear
-Range("D89").Clear
-Range("A89").Value = "xlDialogFormulaReplace"
-Range("B89").Value = 130
-Range("C89").Value = num
-B89 = Range("B89").Value
-C89 = Range("C89").Value
-If B89 = C89 Then
-Range("D89").Value = "OK"
-Else
-Range("D89").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogFunctionWizard(ByRef num)
-Range("A90").Clear
-Range("B90").Clear
-Range("C90").Clear
-Range("D90").Clear
-Range("A90").Value = "xlDialogFunctionWizard"
-Range("B90").Value = 450
-Range("C90").Value = num
-B90 = Range("B90").Value
-C90 = Range("C90").Value
-If B90 = C90 Then
-Range("D90").Value = "OK"
-Else
-Range("D90").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dArea(ByRef num)
-Range("A91").Clear
-Range("B91").Clear
-Range("C91").Clear
-Range("D91").Clear
-Range("A91").Value = "xlDialogGallery3dArea"
-Range("B91").Value = 193
-Range("C91").Value = num
-B91 = Range("B91").Value
-C91 = Range("C91").Value
-If B91 = C91 Then
-Range("D91").Value = "OK"
-Else
-Range("D91").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dBar(ByRef num)
-Range("A92").Clear
-Range("B92").Clear
-Range("C92").Clear
-Range("D92").Clear
-Range("A92").Value = "xlDialogGallery3dBar"
-Range("B92").Value = 272
-Range("C92").Value = num
-B92 = Range("B92").Value
-C92 = Range("C92").Value
-If B92 = C92 Then
-Range("D92").Value = "OK"
-Else
-Range("D92").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dColumn(ByRef num)
-Range("A93").Clear
-Range("B93").Clear
-Range("C93").Clear
-Range("D93").Clear
-Range("A93").Value = "xlDialogGallery3dColumn"
-Range("B93").Value = 194
-Range("C93").Value = num
-B93 = Range("B93").Value
-C93 = Range("C93").Value
-If B93 = C93 Then
-Range("D93").Value = "OK"
-Else
-Range("D93").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dLine(ByRef num)
-Range("A94").Clear
-Range("B94").Clear
-Range("C94").Clear
-Range("D94").Clear
-Range("A94").Value = "xlDialogGallery3dLine"
-Range("B94").Value = 195
-Range("C94").Value = num
-B94 = Range("B94").Value
-C94 = Range("C94").Value
-If B94 = C94 Then
-Range("D94").Value = "OK"
-Else
-Range("D94").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dPie(ByRef num)
-Range("A95").Clear
-Range("B95").Clear
-Range("C95").Clear
-Range("D95").Clear
-Range("A95").Value = "xlDialogGallery3dPie"
-Range("B95").Value = 196
-Range("C95").Value = num
-B95 = Range("B95").Value
-C95 = Range("C95").Value
-If B95 = C95 Then
-Range("D95").Value = "OK"
-Else
-Range("D95").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGallery3dSurface(ByRef num)
-Range("A96").Clear
-Range("B96").Clear
-Range("C96").Clear
-Range("D96").Clear
-Range("A96").Value = "xlDialogGallery3dSurface"
-Range("B96").Value = 273
-Range("C96").Value = num
-B96 = Range("B96").Value
-C96 = Range("C96").Value
-If B96 = C96 Then
-Range("D96").Value = "OK"
-Else
-Range("D96").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryArea(ByRef num)
-Range("A97").Clear
-Range("B97").Clear
-Range("C97").Clear
-Range("D97").Clear
-Range("A97").Value = "xlDialogGalleryArea"
-Range("B97").Value = 67
-Range("C97").Value = num
-B97 = Range("B97").Value
-C97 = Range("C97").Value
-If B97 = C97 Then
-Range("D97").Value = "OK"
-Else
-Range("D97").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryBar(ByRef num)
-Range("A98").Clear
-Range("B98").Clear
-Range("C98").Clear
-Range("D98").Clear
-Range("A98").Value = "xlDialogGalleryBar"
-Range("B98").Value = 68
-Range("C98").Value = num
-B98 = Range("B98").Value
-C98 = Range("C98").Value
-If B98 = C98 Then
-Range("D98").Value = "OK"
-Else
-Range("D98").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryColumn(ByRef num)
-Range("A99").Clear
-Range("B99").Clear
-Range("C99").Clear
-Range("D99").Clear
-Range("A99").Value = "xlDialogGalleryColumn"
-Range("B99").Value = 69
-Range("C99").Value = num
-B99 = Range("B99").Value
-C99 = Range("C99").Value
-If B99 = C99 Then
-Range("D99").Value = "OK"
-Else
-Range("D99").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryCustom(ByRef num)
-Range("A100").Clear
-Range("B100").Clear
-Range("C100").Clear
-Range("D100").Clear
-Range("A100").Value = "xlDialogGalleryCustom"
-Range("B100").Value = 388
-Range("C100").Value = num
-B100 = Range("B100").Value
-C100 = Range("C100").Value
-If B100 = C100 Then
-Range("D100").Value = "OK"
-Else
-Range("D100").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryDoughnut(ByRef num)
-Range("A101").Clear
-Range("B101").Clear
-Range("C101").Clear
-Range("D101").Clear
-Range("A101").Value = "xlDialogGalleryDoughnut"
-Range("B101").Value = 344
-Range("C101").Value = num
-B101 = Range("B101").Value
-C101 = Range("C101").Value
-If B101 = C101 Then
-Range("D101").Value = "OK"
-Else
-Range("D101").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryLine(ByRef num)
-Range("A102").Clear
-Range("B102").Clear
-Range("C102").Clear
-Range("D102").Clear
-Range("A102").Value = "xlDialogGalleryLine"
-Range("B102").Value = 70
-Range("C102").Value = num
-B102 = Range("B102").Value
-C102 = Range("C102").Value
-If B102 = C102 Then
-Range("D102").Value = "OK"
-Else
-Range("D102").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryPie(ByRef num)
-Range("A103").Clear
-Range("B103").Clear
-Range("C103").Clear
-Range("D103").Clear
-Range("A103").Value = "xlDialogGalleryPie"
-Range("B103").Value = 71
-Range("C103").Value = num
-B103 = Range("B103").Value
-C103 = Range("C103").Value
-If B103 = C103 Then
-Range("D103").Value = "OK"
-Else
-Range("D103").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryRader(ByRef num)
-Range("A104").Clear
-Range("B104").Clear
-Range("C104").Clear
-Range("D104").Clear
-Range("A104").Value = "xlDialogGalleryRader"
-Range("B104").Value = 249
-Range("C104").Value = num
-B104 = Range("B104").Value
-C104 = Range("C104").Value
-If B104 = C104 Then
-Range("D104").Value = "OK"
-Else
-Range("D104").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGalleryScatter(ByRef num)
-Range("A105").Clear
-Range("B105").Clear
-Range("C105").Clear
-Range("D105").Clear
-Range("A105").Value = "xlDialogGalleryScatter"
-Range("B105").Value = 72
-Range("C105").Value = num
-B105 = Range("B105").Value
-C105 = Range("C105").Value
-If B105 = C105 Then
-Range("D105").Value = "OK"
-Else
-Range("D105").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGoalSeek(ByRef num)
-Range("A106").Clear
-Range("B106").Clear
-Range("C106").Clear
-Range("D106").Clear
-Range("A106").Value = "xlDialogGoalSeek"
-Range("B106").Value = 198
-Range("C106").Value = num
-B106 = Range("B106").Value
-C106 = Range("C106").Value
-If B106 = C106 Then
-Range("D106").Value = "OK"
-Else
-Range("D106").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogGridlines(ByRef num)
-Range("A107").Clear
-Range("B107").Clear
-Range("C107").Clear
-Range("D107").Clear
-Range("A107").Value = "xlDialogGridlines"
-Range("B107").Value = 76
-Range("C107").Value = num
-B107 = Range("B107").Value
-C107 = Range("C107").Value
-If B107 = C107 Then
-Range("D107").Value = "OK"
-Else
-Range("D107").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogImportTextFile(ByRef num)
-Range("A108").Clear
-Range("B108").Clear
-Range("C108").Clear
-Range("D108").Clear
-Range("A108").Value = "xlDialogImportTextFile"
-Range("B108").Value = 666
-Range("C108").Value = num
-B108 = Range("B108").Value
-C108 = Range("C108").Value
-If B108 = C108 Then
-Range("D108").Value = "OK"
-Else
-Range("D108").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsert(ByRef num)
-Range("A109").Clear
-Range("B109").Clear
-Range("C109").Clear
-Range("D109").Clear
-Range("A109").Value = "xlDialogInsert"
-Range("B109").Value = 55
-Range("C109").Value = num
-B109 = Range("B109").Value
-C109 = Range("C109").Value
-If B109 = C109 Then
-Range("D109").Value = "OK"
-Else
-Range("D109").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsertHyperlink(ByRef num)
-Range("A110").Clear
-Range("B110").Clear
-Range("C110").Clear
-Range("D110").Clear
-Range("A110").Value = "xlDialogInsertHyperlink"
-Range("B110").Value = 596
-Range("C110").Value = num
-B110 = Range("B110").Value
-C110 = Range("C110").Value
-If B110 = C110 Then
-Range("D110").Value = "OK"
-Else
-Range("D110").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsertNameLabel(ByRef num)
-Range("A111").Clear
-Range("B111").Clear
-Range("C111").Clear
-Range("D111").Clear
-Range("A111").Value = "xlDialogInsertNameLabel"
-Range("B111").Value = 496
-Range("C111").Value = num
-B111 = Range("B111").Value
-C111 = Range("C111").Value
-If B111 = C111 Then
-Range("D111").Value = "OK"
-Else
-Range("D111").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsertObject(ByRef num)
-Range("A112").Clear
-Range("B112").Clear
-Range("C112").Clear
-Range("D112").Clear
-Range("A112").Value = "xlDialogInsertObject"
-Range("B112").Value = 259
-Range("C112").Value = num
-B112 = Range("B112").Value
-C112 = Range("C112").Value
-If B112 = C112 Then
-Range("D112").Value = "OK"
-Else
-Range("D112").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsertPicture(ByRef num)
-Range("A113").Clear
-Range("B113").Clear
-Range("C113").Clear
-Range("D113").Clear
-Range("A113").Value = "xlDialogInsertPicture"
-Range("B113").Value = 342
-Range("C113").Value = num
-B113 = Range("B113").Value
-C113 = Range("C113").Value
-If B113 = C113 Then
-Range("D113").Value = "OK"
-Else
-Range("D113").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogInsertTitle(ByRef num)
-Range("A114").Clear
-Range("B114").Clear
-Range("C114").Clear
-Range("D114").Clear
-Range("A114").Value = "xlDialogInsertTitle"
-Range("B114").Value = 380
-Range("C114").Value = num
-B114 = Range("B114").Value
-C114 = Range("C114").Value
-If B114 = C114 Then
-Range("D114").Value = "OK"
-Else
-Range("D114").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogLabelProperties(ByRef num)
-Range("A115").Clear
-Range("B115").Clear
-Range("C115").Clear
-Range("D115").Clear
-Range("A115").Value = "xlDialogLabelProperties"
-Range("B115").Value = 436
-Range("C115").Value = num
-B115 = Range("B115").Value
-C115 = Range("C115").Value
-If B115 = C115 Then
-Range("D115").Value = "OK"
-Else
-Range("D115").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogListboxProperties(ByRef num)
-Range("A116").Clear
-Range("B116").Clear
-Range("C116").Clear
-Range("D116").Clear
-Range("A116").Value = "xlDialogListboxProperties"
-Range("B116").Value = 437
-Range("C116").Value = num
-B116 = Range("B116").Value
-C116 = Range("C116").Value
-If B116 = C116 Then
-Range("D116").Value = "OK"
-Else
-Range("D116").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMacroOptions(ByRef num)
-Range("A117").Clear
-Range("B117").Clear
-Range("C117").Clear
-Range("D117").Clear
-Range("A117").Value = "xlDialogMacroOptions"
-Range("B117").Value = 382
-Range("C117").Value = num
-B117 = Range("B117").Value
-C117 = Range("C117").Value
-If B117 = C117 Then
-Range("D117").Value = "OK"
-Else
-Range("D117").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMailEditMailer(ByRef num)
-Range("A118").Clear
-Range("B118").Clear
-Range("C118").Clear
-Range("D118").Clear
-Range("A118").Value = "xlDialogMailEditMailer"
-Range("B118").Value = 470
-Range("C118").Value = num
-B118 = Range("B118").Value
-C118 = Range("C118").Value
-If B118 = C118 Then
-Range("D118").Value = "OK"
-Else
-Range("D118").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMailLogon(ByRef num)
-Range("A119").Clear
-Range("B119").Clear
-Range("C119").Clear
-Range("D119").Clear
-Range("A119").Value = "xlDialogMailLogon"
-Range("B119").Value = 339
-Range("C119").Value = num
-B119 = Range("B119").Value
-C119 = Range("C119").Value
-If B119 = C119 Then
-Range("D119").Value = "OK"
-Else
-Range("D119").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMailNextLetter(ByRef num)
-Range("A120").Clear
-Range("B120").Clear
-Range("C120").Clear
-Range("D120").Clear
-Range("A120").Value = "xlDialogMailNextLetter"
-Range("B120").Value = 378
-Range("C120").Value = num
-B120 = Range("B120").Value
-C120 = Range("C120").Value
-If B120 = C120 Then
-Range("D120").Value = "OK"
-Else
-Range("D120").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMainChart(ByRef num)
-Range("A121").Clear
-Range("B121").Clear
-Range("C121").Clear
-Range("D121").Clear
-Range("A121").Value = "xlDialogMainChart"
-Range("B121").Value = 85
-Range("C121").Value = num
-B121 = Range("B121").Value
-C121 = Range("C121").Value
-If B121 = C121 Then
-Range("D121").Value = "OK"
-Else
-Range("D121").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMainChartType(ByRef num)
-Range("A122").Clear
-Range("B122").Clear
-Range("C122").Clear
-Range("D122").Clear
-Range("A122").Value = "xlDialogMainChartType"
-Range("B122").Value = 185
-Range("C122").Value = num
-B122 = Range("B122").Value
-C122 = Range("C122").Value
-If B122 = C122 Then
-Range("D122").Value = "OK"
-Else
-Range("D122").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMenuEditor(ByRef num)
-Range("A123").Clear
-Range("B123").Clear
-Range("C123").Clear
-Range("D123").Clear
-Range("A123").Value = "xlDialogMenuEditor"
-Range("B123").Value = 322
-Range("C123").Value = num
-B123 = Range("B123").Value
-C123 = Range("C123").Value
-If B123 = C123 Then
-Range("D123").Value = "OK"
-Else
-Range("D123").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMove(ByRef num)
-Range("A124").Clear
-Range("B124").Clear
-Range("C124").Clear
-Range("D124").Clear
-Range("A124").Value = "xlDialogMove"
-Range("B124").Value = 262
-Range("C124").Value = num
-B124 = Range("B124").Value
-C124 = Range("C124").Value
-If B124 = C124 Then
-Range("D124").Value = "OK"
-Else
-Range("D124").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogMyPermission(ByRef num)
-Range("A125").Clear
-Range("B125").Clear
-Range("C125").Clear
-Range("D125").Clear
-Range("A125").Value = "xlDialogMyPermission"
-Range("B125").Value = 834
-Range("C125").Value = num
-B125 = Range("B125").Value
-C125 = Range("C125").Value
-If B125 = C125 Then
-Range("D125").Value = "OK"
-Else
-Range("D125").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogNew(ByRef num)
-Range("A126").Clear
-Range("B126").Clear
-Range("C126").Clear
-Range("D126").Clear
-Range("A126").Value = "xlDialogNew"
-Range("B126").Value = 119
-Range("C126").Value = num
-B126 = Range("B126").Value
-C126 = Range("C126").Value
-If B126 = C126 Then
-Range("D126").Value = "OK"
-Else
-Range("D126").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogNewWebQuery(ByRef num)
-Range("A127").Clear
-Range("B127").Clear
-Range("C127").Clear
-Range("D127").Clear
-Range("A127").Value = "xlDialogNewWebQuery"
-Range("B127").Value = 667
-Range("C127").Value = num
-B127 = Range("B127").Value
-C127 = Range("C127").Value
-If B127 = C127 Then
-Range("D127").Value = "OK"
-Else
-Range("D127").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogNote(ByRef num)
-Range("A128").Clear
-Range("B128").Clear
-Range("C128").Clear
-Range("D128").Clear
-Range("A128").Value = "xlDialogNote"
-Range("B128").Value = 154
-Range("C128").Value = num
-B128 = Range("B128").Value
-C128 = Range("C128").Value
-If B128 = C128 Then
-Range("D128").Value = "OK"
-Else
-Range("D128").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogObjectProperties(ByRef num)
-Range("A129").Clear
-Range("B129").Clear
-Range("C129").Clear
-Range("D129").Clear
-Range("A129").Value = "xlDialogObjectProperties"
-Range("B129").Value = 207
-Range("C129").Value = num
-B129 = Range("B129").Value
-C129 = Range("C129").Value
-If B129 = C129 Then
-Range("D129").Value = "OK"
-Else
-Range("D129").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogObjectProtection(ByRef num)
-Range("A130").Clear
-Range("B130").Clear
-Range("C130").Clear
-Range("D130").Clear
-Range("A130").Value = "xlDialogObjectProtection"
-Range("B130").Value = 214
-Range("C130").Value = num
-B130 = Range("B130").Value
-C130 = Range("C130").Value
-If B130 = C130 Then
-Range("D130").Value = "OK"
-Else
-Range("D130").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOpen(ByRef num)
-Range("A131").Clear
-Range("B131").Clear
-Range("C131").Clear
-Range("D131").Clear
-Range("A131").Value = "xlDialogOpen"
-Range("B131").Value = 1
-Range("C131").Value = num
-B131 = Range("B131").Value
-C131 = Range("C131").Value
-If B131 = C131 Then
-Range("D131").Value = "OK"
-Else
-Range("D131").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOpenLinks(ByRef num)
-Range("A132").Clear
-Range("B132").Clear
-Range("C132").Clear
-Range("D132").Clear
-Range("A132").Value = "xlDialogOpenLinks"
-Range("B132").Value = 2
-Range("C132").Value = num
-B132 = Range("B132").Value
-C132 = Range("C132").Value
-If B132 = C132 Then
-Range("D132").Value = "OK"
-Else
-Range("D132").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOpenMail(ByRef num)
-Range("A133").Clear
-Range("B133").Clear
-Range("C133").Clear
-Range("D133").Clear
-Range("A133").Value = "xlDialogOpenMail"
-Range("B133").Value = 188
-Range("C133").Value = num
-B133 = Range("B133").Value
-C133 = Range("C133").Value
-If B133 = C133 Then
-Range("D133").Value = "OK"
-Else
-Range("D133").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOpenText(ByRef num)
-Range("A134").Clear
-Range("B134").Clear
-Range("C134").Clear
-Range("D134").Clear
-Range("A134").Value = "xlDialogOpenText"
-Range("B134").Value = 441
-Range("C134").Value = num
-B134 = Range("B134").Value
-C134 = Range("C134").Value
-If B134 = C134 Then
-Range("D134").Value = "OK"
-Else
-Range("D134").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsCalculation(ByRef num)
-Range("A135").Clear
-Range("B135").Clear
-Range("C135").Clear
-Range("D135").Clear
-Range("A135").Value = "xlDialogOptionsCalculation"
-Range("B135").Value = 318
-Range("C135").Value = num
-B135 = Range("B135").Value
-C135 = Range("C135").Value
-If B135 = C135 Then
-Range("D135").Value = "OK"
-Else
-Range("D135").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsChart(ByRef num)
-Range("A136").Clear
-Range("B136").Clear
-Range("C136").Clear
-Range("D136").Clear
-Range("A136").Value = "xlDialogOptionsChart"
-Range("B136").Value = 325
-Range("C136").Value = num
-B136 = Range("B136").Value
-C136 = Range("C136").Value
-If B136 = C136 Then
-Range("D136").Value = "OK"
-Else
-Range("D136").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsEdit(ByRef num)
-Range("A137").Clear
-Range("B137").Clear
-Range("C137").Clear
-Range("D137").Clear
-Range("A137").Value = "xlDialogOptionsEdit"
-Range("B137").Value = 319
-Range("C137").Value = num
-B137 = Range("B137").Value
-C137 = Range("C137").Value
-If B137 = C137 Then
-Range("D137").Value = "OK"
-Else
-Range("D137").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsGeneral(ByRef num)
-Range("A138").Clear
-Range("B138").Clear
-Range("C138").Clear
-Range("D138").Clear
-Range("A138").Value = "xlDialogOptionsGeneral"
-Range("B138").Value = 356
-Range("C138").Value = num
-B138 = Range("B138").Value
-C138 = Range("C138").Value
-If B138 = C138 Then
-Range("D138").Value = "OK"
-Else
-Range("D138").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsListAdd(ByRef num)
-Range("A139").Clear
-Range("B139").Clear
-Range("C139").Clear
-Range("D139").Clear
-Range("A139").Value = "xlDialogOptionsListAdd"
-Range("B139").Value = 458
-Range("C139").Value = num
-B139 = Range("B139").Value
-C139 = Range("C139").Value
-If B139 = C139 Then
-Range("D139").Value = "OK"
-Else
-Range("D139").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsME(ByRef num)
-Range("A140").Clear
-Range("B140").Clear
-Range("C140").Clear
-Range("D140").Clear
-Range("A140").Value = "xlDialogOptionsME"
-Range("B140").Value = 647
-Range("C140").Value = num
-B140 = Range("B140").Value
-C140 = Range("C140").Value
-If B140 = C140 Then
-Range("D140").Value = "OK"
-Else
-Range("D140").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsTransition(ByRef num)
-Range("A141").Clear
-Range("B141").Clear
-Range("C141").Clear
-Range("D141").Clear
-Range("A141").Value = "xlDialogOptionsTransition"
-Range("B141").Value = 355
-Range("C141").Value = num
-B141 = Range("B141").Value
-C141 = Range("C141").Value
-If B141 = C141 Then
-Range("D141").Value = "OK"
-Else
-Range("D141").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOptionsView(ByRef num)
-Range("A142").Clear
-Range("B142").Clear
-Range("C142").Clear
-Range("D142").Clear
-Range("A142").Value = "xlDialogOptionsView"
-Range("B142").Value = 320
-Range("C142").Value = num
-B142 = Range("B142").Value
-C142 = Range("C142").Value
-If B142 = C142 Then
-Range("D142").Value = "OK"
-Else
-Range("D142").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOutline(ByRef num)
-Range("A143").Clear
-Range("B143").Clear
-Range("C143").Clear
-Range("D143").Clear
-Range("A143").Value = "xlDialogOutline"
-Range("B143").Value = 142
-Range("C143").Value = num
-B143 = Range("B143").Value
-C143 = Range("C143").Value
-If B143 = C143 Then
-Range("D143").Value = "OK"
-Else
-Range("D143").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOverlay(ByRef num)
-Range("A144").Clear
-Range("B144").Clear
-Range("C144").Clear
-Range("D144").Clear
-Range("A144").Value = "xlDialogOverlay"
-Range("B144").Value = 86
-Range("C144").Value = num
-B144 = Range("B144").Value
-C144 = Range("C144").Value
-If B144 = C144 Then
-Range("D144").Value = "OK"
-Else
-Range("D144").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogOverlayChartType(ByRef num)
-Range("A145").Clear
-Range("B145").Clear
-Range("C145").Clear
-Range("D145").Clear
-Range("A145").Value = "xlDialogOverlayChartType"
-Range("B145").Value = 186
-Range("C145").Value = num
-B145 = Range("B145").Value
-C145 = Range("C145").Value
-If B145 = C145 Then
-Range("D145").Value = "OK"
-Else
-Range("D145").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPageSetup(ByRef num)
-Range("A146").Clear
-Range("B146").Clear
-Range("C146").Clear
-Range("D146").Clear
-Range("A146").Value = "xlDialogPageSetup"
-Range("B146").Value = 7
-Range("C146").Value = num
-B146 = Range("B146").Value
-C146 = Range("C146").Value
-If B146 = C146 Then
-Range("D146").Value = "OK"
-Else
-Range("D146").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogParse(ByRef num)
-Range("A147").Clear
-Range("B147").Clear
-Range("C147").Clear
-Range("D147").Clear
-Range("A147").Value = "xlDialogParse"
-Range("B147").Value = 91
-Range("C147").Value = num
-B147 = Range("B147").Value
-C147 = Range("C147").Value
-If B147 = C147 Then
-Range("D147").Value = "OK"
-Else
-Range("D147").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPasteNames(ByRef num)
-Range("A148").Clear
-Range("B148").Clear
-Range("C148").Clear
-Range("D148").Clear
-Range("A148").Value = "xlDialogPasteNames"
-Range("B148").Value = 58
-Range("C148").Value = num
-B148 = Range("B148").Value
-C148 = Range("C148").Value
-If B148 = C148 Then
-Range("D148").Value = "OK"
-Else
-Range("D148").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPasteSpecial(ByRef num)
-Range("A149").Clear
-Range("B149").Clear
-Range("C149").Clear
-Range("D149").Clear
-Range("A149").Value = "xlDialogPasteSpecial"
-Range("B149").Value = 53
-Range("C149").Value = num
-B149 = Range("B149").Value
-C149 = Range("C149").Value
-If B149 = C149 Then
-Range("D149").Value = "OK"
-Else
-Range("D149").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPatterns(ByRef num)
-Range("A150").Clear
-Range("B150").Clear
-Range("C150").Clear
-Range("D150").Clear
-Range("A150").Value = "xlDialogPatterns"
-Range("B150").Value = 84
-Range("C150").Value = num
-B150 = Range("B150").Value
-C150 = Range("C150").Value
-If B150 = C150 Then
-Range("D150").Value = "OK"
-Else
-Range("D150").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPermission(ByRef num)
-Range("A151").Clear
-Range("B151").Clear
-Range("C151").Clear
-Range("D151").Clear
-Range("A151").Value = "xlDialogPermission"
-Range("B151").Value = 832
-Range("C151").Value = num
-B151 = Range("B151").Value
-C151 = Range("C151").Value
-If B151 = C151 Then
-Range("D151").Value = "OK"
-Else
-Range("D151").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPhonetic(ByRef num)
-Range("A152").Clear
-Range("B152").Clear
-Range("C152").Clear
-Range("D152").Clear
-Range("A152").Value = "xlDialogPhonetic"
-Range("B152").Value = 656
-Range("C152").Value = num
-B152 = Range("B152").Value
-C152 = Range("C152").Value
-If B152 = C152 Then
-Range("D152").Value = "OK"
-Else
-Range("D152").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotCalculatedField(ByRef num)
-Range("A153").Clear
-Range("B153").Clear
-Range("C153").Clear
-Range("D153").Clear
-Range("A153").Value = "xlDialogPivotCalculatedField"
-Range("B153").Value = 570
-Range("C153").Value = num
-B153 = Range("B153").Value
-C153 = Range("C153").Value
-If B153 = C153 Then
-Range("D153").Value = "OK"
-Else
-Range("D153").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotCalculatedItem(ByRef num)
-Range("A154").Clear
-Range("B154").Clear
-Range("C154").Clear
-Range("D154").Clear
-Range("A154").Value = "xlDialogPivotCalculatedItem"
-Range("B154").Value = 572
-Range("C154").Value = num
-B154 = Range("B154").Value
-C154 = Range("C154").Value
-If B154 = C154 Then
-Range("D154").Value = "OK"
-Else
-Range("D154").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotClientServerSet(ByRef num)
-Range("A155").Clear
-Range("B155").Clear
-Range("C155").Clear
-Range("D155").Clear
-Range("A155").Value = "xlDialogPivotClientServerSet"
-Range("B155").Value = 689
-Range("C155").Value = num
-B155 = Range("B155").Value
-C155 = Range("C155").Value
-If B155 = C155 Then
-Range("D155").Value = "OK"
-Else
-Range("D155").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotFieldGroup(ByRef num)
-Range("A156").Clear
-Range("B156").Clear
-Range("C156").Clear
-Range("D156").Clear
-Range("A156").Value = "xlDialogPivotFieldGroup"
-Range("B156").Value = 433
-Range("C156").Value = num
-B156 = Range("B156").Value
-C156 = Range("C156").Value
-If B156 = C156 Then
-Range("D156").Value = "OK"
-Else
-Range("D156").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotFieldProperties(ByRef num)
-Range("A157").Clear
-Range("B157").Clear
-Range("C157").Clear
-Range("D157").Clear
-Range("A157").Value = "xlDialogPivotFieldProperties"
-Range("B157").Value = 313
-Range("C157").Value = num
-B157 = Range("B157").Value
-C157 = Range("C157").Value
-If B157 = C157 Then
-Range("D157").Value = "OK"
-Else
-Range("D157").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotFieldUngroup(ByRef num)
-Range("A158").Clear
-Range("B158").Clear
-Range("C158").Clear
-Range("D158").Clear
-Range("A158").Value = "xlDialogPivotFieldUngroup"
-Range("B158").Value = 434
-Range("C158").Value = num
-B158 = Range("B158").Value
-C158 = Range("C158").Value
-If B158 = C158 Then
-Range("D158").Value = "OK"
-Else
-Range("D158").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotShowPages(ByRef num)
-Range("A159").Clear
-Range("B159").Clear
-Range("C159").Clear
-Range("D159").Clear
-Range("A159").Value = "xlDialogPivotShowPages"
-Range("B159").Value = 421
-Range("C159").Value = num
-B159 = Range("B159").Value
-C159 = Range("C159").Value
-If B159 = C159 Then
-Range("D159").Value = "OK"
-Else
-Range("D159").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotSolveOrder(ByRef num)
-Range("A160").Clear
-Range("B160").Clear
-Range("C160").Clear
-Range("D160").Clear
-Range("A160").Value = "xlDialogPivotSolveOrder"
-Range("B160").Value = 568
-Range("C160").Value = num
-B160 = Range("B160").Value
-C160 = Range("C160").Value
-If B160 = C160 Then
-Range("D160").Value = "OK"
-Else
-Range("D160").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotTableOptions(ByRef num)
-Range("A161").Clear
-Range("B161").Clear
-Range("C161").Clear
-Range("D161").Clear
-Range("A161").Value = "xlDialogPivotTableOptions"
-Range("B161").Value = 567
-Range("C161").Value = num
-B161 = Range("B161").Value
-C161 = Range("C161").Value
-If B161 = C161 Then
-Range("D161").Value = "OK"
-Else
-Range("D161").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPivotTableWizard(ByRef num)
-Range("A162").Clear
-Range("B162").Clear
-Range("C162").Clear
-Range("D162").Clear
-Range("A162").Value = "xlDialogPivotTableWizard"
-Range("B162").Value = 321
-Range("C162").Value = num
-B162 = Range("B162").Value
-C162 = Range("C162").Value
-If B162 = C162 Then
-Range("D162").Value = "OK"
-Else
-Range("D162").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPlacement(ByRef num)
-Range("A163").Clear
-Range("B163").Clear
-Range("C163").Clear
-Range("D163").Clear
-Range("A163").Value = "xlDialogPlacement"
-Range("B163").Value = 300
-Range("C163").Value = num
-B163 = Range("B163").Value
-C163 = Range("C163").Value
-If B163 = C163 Then
-Range("D163").Value = "OK"
-Else
-Range("D163").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPrint(ByRef num)
-Range("A164").Clear
-Range("B164").Clear
-Range("C164").Clear
-Range("D164").Clear
-Range("A164").Value = "xlDialogPrint"
-Range("B164").Value = 8
-Range("C164").Value = num
-B164 = Range("B164").Value
-C164 = Range("C164").Value
-If B164 = C164 Then
-Range("D164").Value = "OK"
-Else
-Range("D164").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPrintSetup(ByRef num)
-Range("A165").Clear
-Range("B165").Clear
-Range("C165").Clear
-Range("D165").Clear
-Range("A165").Value = "xlDialogPrintSetup"
-Range("B165").Value = 9
-Range("C165").Value = num
-B165 = Range("B165").Value
-C165 = Range("C165").Value
-If B165 = C165 Then
-Range("D165").Value = "OK"
-Else
-Range("D165").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPrintPreview(ByRef num)
-Range("A166").Clear
-Range("B166").Clear
-Range("C166").Clear
-Range("D166").Clear
-Range("A166").Value = "xlDialogPrintPreview"
-Range("B166").Value = 222
-Range("C166").Value = num
-B166 = Range("B166").Value
-C166 = Range("C166").Value
-If B166 = C166 Then
-Range("D166").Value = "OK"
-Else
-Range("D166").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPromote(ByRef num)
-Range("A167").Clear
-Range("B167").Clear
-Range("C167").Clear
-Range("D167").Clear
-Range("A167").Value = "xlDialogPromote"
-Range("B167").Value = 202
-Range("C167").Value = num
-B167 = Range("B167").Value
-C167 = Range("C167").Value
-If B167 = C167 Then
-Range("D167").Value = "OK"
-Else
-Range("D167").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogProperties(ByRef num)
-Range("A168").Clear
-Range("B168").Clear
-Range("C168").Clear
-Range("D168").Clear
-Range("A168").Value = "xlDialogProperties"
-Range("B168").Value = 474
-Range("C168").Value = num
-B168 = Range("B168").Value
-C168 = Range("C168").Value
-If B168 = C168 Then
-Range("D168").Value = "OK"
-Else
-Range("D168").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPropertyFields(ByRef num)
-Range("A169").Clear
-Range("B169").Clear
-Range("C169").Clear
-Range("D169").Clear
-Range("A169").Value = "xlDialogPropertyFields"
-Range("B169").Value = 754
-Range("C169").Value = num
-B169 = Range("B169").Value
-C169 = Range("C169").Value
-If B169 = C169 Then
-Range("D169").Value = "OK"
-Else
-Range("D169").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogProtectDocument(ByRef num)
-Range("A170").Clear
-Range("B170").Clear
-Range("C170").Clear
-Range("D170").Clear
-Range("A170").Value = "xlDialogProtectDocument"
-Range("B170").Value = 28
-Range("C170").Value = num
-B170 = Range("B170").Value
-C170 = Range("C170").Value
-If B170 = C170 Then
-Range("D170").Value = "OK"
-Else
-Range("D170").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogProtectSharing(ByRef num)
-Range("A171").Clear
-Range("B171").Clear
-Range("C171").Clear
-Range("D171").Clear
-Range("A171").Value = "xlDialogProtectSharing"
-Range("B171").Value = 620
-Range("C171").Value = num
-B171 = Range("B171").Value
-C171 = Range("C171").Value
-If B171 = C171 Then
-Range("D171").Value = "OK"
-Else
-Range("D171").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPublishAsWebPage(ByRef num)
-Range("A172").Clear
-Range("B172").Clear
-Range("C172").Clear
-Range("D172").Clear
-Range("A172").Value = "xlDialogPublishAsWebPage"
-Range("B172").Value = 653
-Range("C172").Value = num
-B172 = Range("B172").Value
-C172 = Range("C172").Value
-If B172 = C172 Then
-Range("D172").Value = "OK"
-Else
-Range("D172").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogPushbuttonProperties(ByRef num)
-Range("A173").Clear
-Range("B173").Clear
-Range("C173").Clear
-Range("D173").Clear
-Range("A173").Value = "xlDialogPushbuttonProperties"
-Range("B173").Value = 445
-Range("C173").Value = num
-B173 = Range("B173").Value
-C173 = Range("C173").Value
-If B173 = C173 Then
-Range("D173").Value = "OK"
-Else
-Range("D173").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogReplaceFont(ByRef num)
-Range("A174").Clear
-Range("B174").Clear
-Range("C174").Clear
-Range("D174").Clear
-Range("A174").Value = "xlDialogReplaceFont"
-Range("B174").Value = 134
-Range("C174").Value = num
-B174 = Range("B174").Value
-C174 = Range("C174").Value
-If B174 = C174 Then
-Range("D174").Value = "OK"
-Else
-Range("D174").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogRoutingSlip(ByRef num)
-Range("A175").Clear
-Range("B175").Clear
-Range("C175").Clear
-Range("D175").Clear
-Range("A175").Value = "xlDialogRoutingSlip"
-Range("B175").Value = 336
-Range("C175").Value = num
-B175 = Range("B175").Value
-C175 = Range("C175").Value
-If B175 = C175 Then
-Range("D175").Value = "OK"
-Else
-Range("D175").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogRowHeight(ByRef num)
-Range("A176").Clear
-Range("B176").Clear
-Range("C176").Clear
-Range("D176").Clear
-Range("A176").Value = "xlDialogRowHeight"
-Range("B176").Value = 127
-Range("C176").Value = num
-B176 = Range("B176").Value
-C176 = Range("C176").Value
-If B176 = C176 Then
-Range("D176").Value = "OK"
-Else
-Range("D176").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogRun(ByRef num)
-Range("A177").Clear
-Range("B177").Clear
-Range("C177").Clear
-Range("D177").Clear
-Range("A177").Value = "xlDialogRun"
-Range("B177").Value = 17
-Range("C177").Value = num
-B177 = Range("B177").Value
-C177 = Range("C177").Value
-If B177 = C177 Then
-Range("D177").Value = "OK"
-Else
-Range("D177").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSaveAs(ByRef num)
-Range("A178").Clear
-Range("B178").Clear
-Range("C178").Clear
-Range("D178").Clear
-Range("A178").Value = "xlDialogSaveAs"
-Range("B178").Value = 5
-Range("C178").Value = num
-B178 = Range("B178").Value
-C178 = Range("C178").Value
-If B178 = C178 Then
-Range("D178").Value = "OK"
-Else
-Range("D178").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSaveCopyAs(ByRef num)
-Range("A179").Clear
-Range("B179").Clear
-Range("C179").Clear
-Range("D179").Clear
-Range("A179").Value = "xlDialogSaveCopyAs"
-Range("B179").Value = 456
-Range("C179").Value = num
-B179 = Range("B179").Value
-C179 = Range("C179").Value
-If B179 = C179 Then
-Range("D179").Value = "OK"
-Else
-Range("D179").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSaveNewObject(ByRef num)
-Range("A180").Clear
-Range("B180").Clear
-Range("C180").Clear
-Range("D180").Clear
-Range("A180").Value = "xlDialogSaveNewObject"
-Range("B180").Value = 208
-Range("C180").Value = num
-B180 = Range("B180").Value
-C180 = Range("C180").Value
-If B180 = C180 Then
-Range("D180").Value = "OK"
-Else
-Range("D180").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSaveWorkbook(ByRef num)
-Range("A181").Clear
-Range("B181").Clear
-Range("C181").Clear
-Range("D181").Clear
-Range("A181").Value = "xlDialogSaveWorkbook"
-Range("B181").Value = 145
-Range("C181").Value = num
-B181 = Range("B181").Value
-C181 = Range("C181").Value
-If B181 = C181 Then
-Range("D181").Value = "OK"
-Else
-Range("D181").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSaveWorkspace(ByRef num)
-Range("A182").Clear
-Range("B182").Clear
-Range("C182").Clear
-Range("D182").Clear
-Range("A182").Value = "xlDialogSaveWorkspace"
-Range("B182").Value = 285
-Range("C182").Value = num
-B182 = Range("B182").Value
-C182 = Range("C182").Value
-If B182 = C182 Then
-Range("D182").Value = "OK"
-Else
-Range("D182").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScale(ByRef num)
-Range("A183").Clear
-Range("B183").Clear
-Range("C183").Clear
-Range("D183").Clear
-Range("A183").Value = "xlDialogScale"
-Range("B183").Value = 87
-Range("C183").Value = num
-B183 = Range("B183").Value
-C183 = Range("C183").Value
-If B183 = C183 Then
-Range("D183").Value = "OK"
-Else
-Range("D183").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScenarioAdd(ByRef num)
-Range("A184").Clear
-Range("B184").Clear
-Range("C184").Clear
-Range("D184").Clear
-Range("A184").Value = "xlDialogScenarioAdd"
-Range("B184").Value = 307
-Range("C184").Value = num
-B184 = Range("B184").Value
-C184 = Range("C184").Value
-If B184 = C184 Then
-Range("D184").Value = "OK"
-Else
-Range("D184").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScenarioCells(ByRef num)
-Range("A185").Clear
-Range("B185").Clear
-Range("C185").Clear
-Range("D185").Clear
-Range("A185").Value = "xlDialogScenarioCells"
-Range("B185").Value = 305
-Range("C185").Value = num
-B185 = Range("B185").Value
-C185 = Range("C185").Value
-If B185 = C185 Then
-Range("D185").Value = "OK"
-Else
-Range("D185").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScenarioEdit(ByRef num)
-Range("A186").Clear
-Range("B186").Clear
-Range("C186").Clear
-Range("D186").Clear
-Range("A186").Value = "xlDialogScenarioEdit"
-Range("B186").Value = 308
-Range("C186").Value = num
-B186 = Range("B186").Value
-C186 = Range("C186").Value
-If B186 = C186 Then
-Range("D186").Value = "OK"
-Else
-Range("D186").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScenarioMerge(ByRef num)
-Range("A187").Clear
-Range("B187").Clear
-Range("C187").Clear
-Range("D187").Clear
-Range("A187").Value = "xlDialogScenarioMerge"
-Range("B187").Value = 473
-Range("C187").Value = num
-B187 = Range("B187").Value
-C187 = Range("C187").Value
-If B187 = C187 Then
-Range("D187").Value = "OK"
-Else
-Range("D187").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScenarioSummary(ByRef num)
-Range("A188").Clear
-Range("B188").Clear
-Range("C188").Clear
-Range("D188").Clear
-Range("A188").Value = "xlDialogScenarioSummary"
-Range("B188").Value = 311
-Range("C188").Value = num
-B188 = Range("B188").Value
-C188 = Range("C188").Value
-If B188 = C188 Then
-Range("D188").Value = "OK"
-Else
-Range("D188").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogScrollbarProperties(ByRef num)
-Range("A189").Clear
-Range("B189").Clear
-Range("C189").Clear
-Range("D189").Clear
-Range("A189").Value = "xlDialogScrollbarProperties"
-Range("B189").Value = 420
-Range("C189").Value = num
-B189 = Range("B189").Value
-C189 = Range("C189").Value
-If B189 = C189 Then
-Range("D189").Value = "OK"
-Else
-Range("D189").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSearch(ByRef num)
-Range("A190").Clear
-Range("B190").Clear
-Range("C190").Clear
-Range("D190").Clear
-Range("A190").Value = "xlDialogSearch"
-Range("B190").Value = 731
-Range("C190").Value = num
-B190 = Range("B190").Value
-C190 = Range("C190").Value
-If B190 = C190 Then
-Range("D190").Value = "OK"
-Else
-Range("D190").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSelectSpecial(ByRef num)
-Range("A191").Clear
-Range("B191").Clear
-Range("C191").Clear
-Range("D191").Clear
-Range("A191").Value = "xlDialogSelectSpecial"
-Range("B191").Value = 132
-Range("C191").Value = num
-B191 = Range("B191").Value
-C191 = Range("C191").Value
-If B191 = C191 Then
-Range("D191").Value = "OK"
-Else
-Range("D191").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSendMail(ByRef num)
-Range("A192").Clear
-Range("B192").Clear
-Range("C192").Clear
-Range("D192").Clear
-Range("A192").Value = "xlDialogSendMail"
-Range("B192").Value = 189
-Range("C192").Value = num
-B192 = Range("B192").Value
-C192 = Range("C192").Value
-If B192 = C192 Then
-Range("D192").Value = "OK"
-Else
-Range("D192").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesAxes(ByRef num)
-Range("A193").Clear
-Range("B193").Clear
-Range("C193").Clear
-Range("D193").Clear
-Range("A193").Value = "xlDialogSeriesAxes"
-Range("B193").Value = 450
-Range("C193").Value = num
-B193 = Range("B193").Value
-C193 = Range("C193").Value
-If B193 = C193 Then
-Range("D193").Value = "OK"
-Else
-Range("D193").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesOptions(ByRef num)
-Range("A194").Clear
-Range("B194").Clear
-Range("C194").Clear
-Range("D194").Clear
-Range("A194").Value = "xlDialogSeriesOptions"
-Range("B194").Value = 557
-Range("C194").Value = num
-B194 = Range("B194").Value
-C194 = Range("C194").Value
-If B194 = C194 Then
-Range("D194").Value = "OK"
-Else
-Range("D194").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesOrder(ByRef num)
-Range("A195").Clear
-Range("B195").Clear
-Range("C195").Clear
-Range("D195").Clear
-Range("A195").Value = "xlDialogSeriesOrder"
-Range("B195").Value = 466
-Range("C195").Value = num
-B195 = Range("B195").Value
-C195 = Range("C195").Value
-If B195 = C195 Then
-Range("D195").Value = "OK"
-Else
-Range("D195").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesShape(ByRef num)
-Range("A196").Clear
-Range("B196").Clear
-Range("C196").Clear
-Range("D196").Clear
-Range("A196").Value = "xlDialogSeriesShape"
-Range("B196").Value = 504
-Range("C196").Value = num
-B196 = Range("B196").Value
-C196 = Range("C196").Value
-If B196 = C196 Then
-Range("D196").Value = "OK"
-Else
-Range("D196").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesX(ByRef num)
-Range("A197").Clear
-Range("B197").Clear
-Range("C197").Clear
-Range("D197").Clear
-Range("A197").Value = "xlDialogSeriesX"
-Range("B197").Value = 461
-Range("C197").Value = num
-B197 = Range("B197").Value
-C197 = Range("C197").Value
-If B197 = C197 Then
-Range("D197").Value = "OK"
-Else
-Range("D197").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSeriesY(ByRef num)
-Range("A198").Clear
-Range("B198").Clear
-Range("C198").Clear
-Range("D198").Clear
-Range("A198").Value = "xlDialogSeriesY"
-Range("B198").Value = 462
-Range("C198").Value = num
-B198 = Range("B198").Value
-C198 = Range("C198").Value
-If B198 = C198 Then
-Range("D198").Value = "OK"
-Else
-Range("D198").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSetBackgroundPicture(ByRef num)
-Range("A199").Clear
-Range("B199").Clear
-Range("C199").Clear
-Range("D199").Clear
-Range("A199").Value = "xlDialogSetBackgroundPicture"
-Range("B199").Value = 509
-Range("C199").Value = num
-B199 = Range("B199").Value
-C199 = Range("C199").Value
-If B199 = C199 Then
-Range("D199").Value = "OK"
-Else
-Range("D199").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSetPrintTitles(ByRef num)
-Range("A200").Clear
-Range("B200").Clear
-Range("C200").Clear
-Range("D200").Clear
-Range("A200").Value = "xlDialogSetPrintTitles"
-Range("B200").Value = 23
-Range("C200").Value = num
-B200 = Range("B200").Value
-C200 = Range("C200").Value
-If B200 = C200 Then
-Range("D200").Value = "OK"
-Else
-Range("D200").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSetUpdateStatus(ByRef num)
-Range("A201").Clear
-Range("B201").Clear
-Range("C201").Clear
-Range("D201").Clear
-Range("A201").Value = "xlDialogSetUpdateStatus"
-Range("B201").Value = 159
-Range("C201").Value = num
-B201 = Range("B201").Value
-C201 = Range("C201").Value
-If B201 = C201 Then
-Range("D201").Value = "OK"
-Else
-Range("D201").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogShowDetail(ByRef num)
-Range("A202").Clear
-Range("B202").Clear
-Range("C202").Clear
-Range("D202").Clear
-Range("A202").Value = "xlDialogShowDetail"
-Range("B202").Value = 204
-Range("C202").Value = num
-B202 = Range("B202").Value
-C202 = Range("C202").Value
-If B202 = C202 Then
-Range("D202").Value = "OK"
-Else
-Range("D202").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogShowToolbar(ByRef num)
-Range("A203").Clear
-Range("B203").Clear
-Range("C203").Clear
-Range("D203").Clear
-Range("A203").Value = "xlDialogShowToolbar"
-Range("B203").Value = 220
-Range("C203").Value = num
-B203 = Range("B203").Value
-C203 = Range("C203").Value
-If B203 = C203 Then
-Range("D203").Value = "OK"
-Else
-Range("D203").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSize(ByRef num)
-Range("A204").Clear
-Range("B204").Clear
-Range("C204").Clear
-Range("D204").Clear
-Range("A204").Value = "xlDialogSize"
-Range("B204").Value = 261
-Range("C204").Value = num
-B204 = Range("B204").Value
-C204 = Range("C204").Value
-If B204 = C204 Then
-Range("D204").Value = "OK"
-Else
-Range("D204").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSort(ByRef num)
-Range("A205").Clear
-Range("B205").Clear
-Range("C205").Clear
-Range("D205").Clear
-Range("A205").Value = "xlDialogSort"
-Range("B205").Value = 39
-Range("C205").Value = num
-B205 = Range("B205").Value
-C205 = Range("C205").Value
-If B205 = C205 Then
-Range("D205").Value = "OK"
-Else
-Range("D205").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSortSpecial(ByRef num)
-Range("A206").Clear
-Range("B206").Clear
-Range("C206").Clear
-Range("D206").Clear
-Range("A206").Value = "xlDialogSortSpecial"
-Range("B206").Value = 192
-Range("C206").Value = num
-B206 = Range("B206").Value
-C206 = Range("C206").Value
-If B206 = C206 Then
-Range("D206").Value = "OK"
-Else
-Range("D206").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSplit(ByRef num)
-Range("A207").Clear
-Range("B207").Clear
-Range("C207").Clear
-Range("D207").Clear
-Range("A207").Value = "xlDialogSplit"
-Range("B207").Value = 137
-Range("C207").Value = num
-B207 = Range("B207").Value
-C207 = Range("C207").Value
-If B207 = C207 Then
-Range("D207").Value = "OK"
-Else
-Range("D207").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogStandardFont(ByRef num)
-Range("A208").Clear
-Range("B208").Clear
-Range("C208").Clear
-Range("D208").Clear
-Range("A208").Value = "xlDialogStandardFont"
-Range("B208").Value = 190
-Range("C208").Value = num
-B208 = Range("B208").Value
-C208 = Range("C208").Value
-If B208 = C208 Then
-Range("D208").Value = "OK"
-Else
-Range("D208").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogStandardWidth(ByRef num)
-Range("A209").Clear
-Range("B209").Clear
-Range("C209").Clear
-Range("D209").Clear
-Range("A209").Value = "xlDialogStandardWidth"
-Range("B209").Value = 472
-Range("C209").Value = num
-B209 = Range("B209").Value
-C209 = Range("C209").Value
-If B209 = C209 Then
-Range("D209").Value = "OK"
-Else
-Range("D209").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogStyle(ByRef num)
-Range("A210").Clear
-Range("B210").Clear
-Range("C210").Clear
-Range("D210").Clear
-Range("A210").Value = "xlDialogStyle"
-Range("B210").Value = 44
-Range("C210").Value = num
-B210 = Range("B210").Value
-C210 = Range("C210").Value
-If B210 = C210 Then
-Range("D210").Value = "OK"
-Else
-Range("D210").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSubscribeTo(ByRef num)
-Range("A211").Clear
-Range("B211").Clear
-Range("C211").Clear
-Range("D211").Clear
-Range("A211").Value = "xlDialogSubscribeTo"
-Range("B211").Value = 218
-Range("C211").Value = num
-B211 = Range("B211").Value
-C211 = Range("C211").Value
-If B211 = C211 Then
-Range("D211").Value = "OK"
-Else
-Range("D211").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSubtotalCreate(ByRef num)
-Range("A212").Clear
-Range("B212").Clear
-Range("C212").Clear
-Range("D212").Clear
-Range("A212").Value = "xlDialogSubtotalCreate"
-Range("B212").Value = 398
-Range("C212").Value = num
-B212 = Range("B212").Value
-C212 = Range("C212").Value
-If B212 = C212 Then
-Range("D212").Value = "OK"
-Else
-Range("D212").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSummaryInfo(ByRef num)
-Range("A213").Clear
-Range("B213").Clear
-Range("C213").Clear
-Range("D213").Clear
-Range("A213").Value = "xlDialogSummaryInfo"
-Range("B213").Value = 474
-Range("C213").Value = num
-B213 = Range("B213").Value
-C213 = Range("C213").Value
-If B213 = C213 Then
-Range("D213").Value = "OK"
-Else
-Range("D213").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogTable(ByRef num)
-Range("A214").Clear
-Range("B214").Clear
-Range("C214").Clear
-Range("D214").Clear
-Range("A214").Value = "xlDialogTable"
-Range("B214").Value = 41
-Range("C214").Value = num
-B214 = Range("B214").Value
-C214 = Range("C214").Value
-If B214 = C214 Then
-Range("D214").Value = "OK"
-Else
-Range("D214").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogTabOrder(ByRef num)
-Range("A215").Clear
-Range("B215").Clear
-Range("C215").Clear
-Range("D215").Clear
-Range("A215").Value = "xlDialogTabOrder"
-Range("B215").Value = 394
-Range("C215").Value = num
-B215 = Range("B215").Value
-C215 = Range("C215").Value
-If B215 = C215 Then
-Range("D215").Value = "OK"
-Else
-Range("D215").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogTextToColumns(ByRef num)
-Range("A216").Clear
-Range("B216").Clear
-Range("C216").Clear
-Range("D216").Clear
-Range("A216").Value = "xlDialogTextToColumns"
-Range("B216").Value = 422
-Range("C216").Value = num
-B216 = Range("B216").Value
-C216 = Range("C216").Value
-If B216 = C216 Then
-Range("D216").Value = "OK"
-Else
-Range("D216").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogUnhide(ByRef num)
-Range("A217").Clear
-Range("B217").Clear
-Range("C217").Clear
-Range("D217").Clear
-Range("A217").Value = "xlDialogUnhide"
-Range("B217").Value = 94
-Range("C217").Value = num
-B217 = Range("B217").Value
-C217 = Range("C217").Value
-If B217 = C217 Then
-Range("D217").Value = "OK"
-Else
-Range("D217").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogUpdateLink(ByRef num)
-Range("A218").Clear
-Range("B218").Clear
-Range("C218").Clear
-Range("D218").Clear
-Range("A218").Value = "xlDialogUpdateLink"
-Range("B218").Value = 201
-Range("C218").Value = num
-B218 = Range("B218").Value
-C218 = Range("C218").Value
-If B218 = C218 Then
-Range("D218").Value = "OK"
-Else
-Range("D218").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogVbaInsertFile(ByRef num)
-Range("A219").Clear
-Range("B219").Clear
-Range("C219").Clear
-Range("D219").Clear
-Range("A219").Value = "xlDialogVbaInsertFile"
-Range("B219").Value = 328
-Range("C219").Value = num
-B219 = Range("B219").Value
-C219 = Range("C219").Value
-If B219 = C219 Then
-Range("D219").Value = "OK"
-Else
-Range("D219").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogVbaMakeAddin(ByRef num)
-Range("A220").Clear
-Range("B220").Clear
-Range("C220").Clear
-Range("D220").Clear
-Range("A220").Value = "xlDialogVbaMakeAddin"
-Range("B220").Value = 478
-Range("C220").Value = num
-B220 = Range("B220").Value
-C220 = Range("C220").Value
-If B220 = C220 Then
-Range("D220").Value = "OK"
-Else
-Range("D220").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogVbaProcedureDefinition(ByRef num)
-Range("A221").Clear
-Range("B221").Clear
-Range("C221").Clear
-Range("D221").Clear
-Range("A221").Value = "xlDialogVbaProcedureDefinition"
-Range("B221").Value = 330
-Range("C221").Value = num
-B221 = Range("B221").Value
-C221 = Range("C221").Value
-If B221 = C221 Then
-Range("D221").Value = "OK"
-Else
-Range("D221").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogView3d(ByRef num)
-Range("A222").Clear
-Range("B222").Clear
-Range("C222").Clear
-Range("D222").Clear
-Range("A222").Value = "xlDialogView3d"
-Range("B222").Value = 197
-Range("C222").Value = num
-B222 = Range("B222").Value
-C222 = Range("C222").Value
-If B222 = C222 Then
-Range("D222").Value = "OK"
-Else
-Range("D222").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsBrowsers(ByRef num)
-Range("A223").Clear
-Range("B223").Clear
-Range("C223").Clear
-Range("D223").Clear
-Range("A223").Value = "xlDialogWebOptionsBrowsers"
-Range("B223").Value = 773
-Range("C223").Value = num
-B223 = Range("B223").Value
-C223 = Range("C223").Value
-If B223 = C223 Then
-Range("D223").Value = "OK"
-Else
-Range("D223").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsEncoding(ByRef num)
-Range("A224").Clear
-Range("B224").Clear
-Range("C224").Clear
-Range("D224").Clear
-Range("A224").Value = "xlDialogWebOptionsEncoding"
-Range("B224").Value = 686
-Range("C224").Value = num
-B224 = Range("B224").Value
-C224 = Range("C224").Value
-If B224 = C224 Then
-Range("D224").Value = "OK"
-Else
-Range("D224").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsFiles(ByRef num)
-Range("A225").Clear
-Range("B225").Clear
-Range("C225").Clear
-Range("D225").Clear
-Range("A225").Value = "xlDialogWebOptionsFiles"
-Range("B225").Value = 684
-Range("C225").Value = num
-B225 = Range("B225").Value
-C225 = Range("C225").Value
-If B225 = C225 Then
-Range("D225").Value = "OK"
-Else
-Range("D225").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsFonts(ByRef num)
-Range("A226").Clear
-Range("B226").Clear
-Range("C226").Clear
-Range("D226").Clear
-Range("A226").Value = "xlDialogWebOptionsFonts"
-Range("B226").Value = 687
-Range("C226").Value = num
-B226 = Range("B226").Value
-C226 = Range("C226").Value
-If B226 = C226 Then
-Range("D226").Value = "OK"
-Else
-Range("D226").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsGeneral(ByRef num)
-Range("A227").Clear
-Range("B227").Clear
-Range("C227").Clear
-Range("D227").Clear
-Range("A227").Value = "xlDialogWebOptionsGeneral"
-Range("B227").Value = 683
-Range("C227").Value = num
-B227 = Range("B227").Value
-C227 = Range("C227").Value
-If B227 = C227 Then
-Range("D227").Value = "OK"
-Else
-Range("D227").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWebOptionsPictures(ByRef num)
-Range("A228").Clear
-Range("B228").Clear
-Range("C228").Clear
-Range("D228").Clear
-Range("A228").Value = "xlDialogWebOptionsPictures"
-Range("B228").Value = 685
-Range("C228").Value = num
-B228 = Range("B228").Value
-C228 = Range("C228").Value
-If B228 = C228 Then
-Range("D228").Value = "OK"
-Else
-Range("D228").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWindowMove(ByRef num)
-Range("A229").Clear
-Range("B229").Clear
-Range("C229").Clear
-Range("D229").Clear
-Range("A229").Value = "xlDialogWindowMove"
-Range("B229").Value = 14
-Range("C229").Value = num
-B229 = Range("B229").Value
-C229 = Range("C229").Value
-If B229 = C229 Then
-Range("D229").Value = "OK"
-Else
-Range("D229").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWindowSize(ByRef num)
-Range("A230").Clear
-Range("B230").Clear
-Range("C230").Clear
-Range("D230").Clear
-Range("A230").Value = "xlDialogWindowSize"
-Range("B230").Value = 13
-Range("C230").Value = num
-B230 = Range("B230").Value
-C230 = Range("C230").Value
-If B230 = C230 Then
-Range("D230").Value = "OK"
-Else
-Range("D230").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookAdd(ByRef num)
-Range("A231").Clear
-Range("B231").Clear
-Range("C231").Clear
-Range("D231").Clear
-Range("A231").Value = "xlDialogWorkbookAdd"
-Range("B231").Value = 281
-Range("C231").Value = num
-B231 = Range("B231").Value
-C231 = Range("C231").Value
-If B231 = C231 Then
-Range("D231").Value = "OK"
-Else
-Range("D231").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookCopy(ByRef num)
-Range("A232").Clear
-Range("B232").Clear
-Range("C232").Clear
-Range("D232").Clear
-Range("A232").Value = "xlDialogWorkbookCopy"
-Range("B232").Value = 283
-Range("C232").Value = num
-B232 = Range("B232").Value
-C232 = Range("C232").Value
-If B232 = C232 Then
-Range("D232").Value = "OK"
-Else
-Range("D232").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookInsert(ByRef num)
-Range("A233").Clear
-Range("B233").Clear
-Range("C233").Clear
-Range("D233").Clear
-Range("A233").Value = "xlDialogWorkbookInsert"
-Range("B233").Value = 354
-Range("C233").Value = num
-B233 = Range("B233").Value
-C233 = Range("C233").Value
-If B233 = C233 Then
-Range("D233").Value = "OK"
-Else
-Range("D233").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookMove(ByRef num)
-Range("A234").Clear
-Range("B234").Clear
-Range("C234").Clear
-Range("D234").Clear
-Range("A234").Value = "xlDialogWorkbookMove"
-Range("B234").Value = 282
-Range("C234").Value = num
-B234 = Range("B234").Value
-C234 = Range("C234").Value
-If B234 = C234 Then
-Range("D234").Value = "OK"
-Else
-Range("D234").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookName(ByRef num)
-Range("A235").Clear
-Range("B235").Clear
-Range("C235").Clear
-Range("D235").Clear
-Range("A235").Value = "xlDialogWorkbookName"
-Range("B235").Value = 386
-Range("C235").Value = num
-B235 = Range("B235").Value
-C235 = Range("C235").Value
-If B235 = C235 Then
-Range("D235").Value = "OK"
-Else
-Range("D235").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookNew(ByRef num)
-Range("A236").Clear
-Range("B236").Clear
-Range("C236").Clear
-Range("D236").Clear
-Range("A236").Value = "xlDialogWorkbookNew"
-Range("B236").Value = 302
-Range("C236").Value = num
-B236 = Range("B236").Value
-C236 = Range("C236").Value
-If B236 = C236 Then
-Range("D236").Value = "OK"
-Else
-Range("D236").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookOptions(ByRef num)
-Range("A237").Clear
-Range("B237").Clear
-Range("C237").Clear
-Range("D237").Clear
-Range("A237").Value = "xlDialogWorkbookOptions"
-Range("B237").Value = 284
-Range("C237").Value = num
-B237 = Range("B237").Value
-C237 = Range("C237").Value
-If B237 = C237 Then
-Range("D237").Value = "OK"
-Else
-Range("D237").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookProtect(ByRef num)
-Range("A238").Clear
-Range("B238").Clear
-Range("C238").Clear
-Range("D238").Clear
-Range("A238").Value = "xlDialogWorkbookProtect"
-Range("B238").Value = 417
-Range("C238").Value = num
-B238 = Range("B238").Value
-C238 = Range("C238").Value
-If B238 = C238 Then
-Range("D238").Value = "OK"
-Else
-Range("D238").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookTabSplit(ByRef num)
-Range("A239").Clear
-Range("B239").Clear
-Range("C239").Clear
-Range("D239").Clear
-Range("A239").Value = "xlDialogWorkbookTabSplit"
-Range("B239").Value = 415
-Range("C239").Value = num
-B239 = Range("B239").Value
-C239 = Range("C239").Value
-If B239 = C239 Then
-Range("D239").Value = "OK"
-Else
-Range("D239").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkbookUnhide(ByRef num)
-Range("A240").Clear
-Range("B240").Clear
-Range("C240").Clear
-Range("D240").Clear
-Range("A240").Value = "xlDialogWorkbookUnhide"
-Range("B240").Value = 384
-Range("C240").Value = num
-B240 = Range("B240").Value
-C240 = Range("C240").Value
-If B240 = C240 Then
-Range("D240").Value = "OK"
-Else
-Range("D240").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkgroup(ByRef num)
-Range("A241").Clear
-Range("B241").Clear
-Range("C241").Clear
-Range("D241").Clear
-Range("A241").Value = "xlDialogWorkgroup"
-Range("B241").Value = 199
-Range("C241").Value = num
-B241 = Range("B241").Value
-C241 = Range("C241").Value
-If B241 = C241 Then
-Range("D241").Value = "OK"
-Else
-Range("D241").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogWorkspace(ByRef num)
-Range("A242").Clear
-Range("B242").Clear
-Range("C242").Clear
-Range("D242").Clear
-Range("A242").Value = "xlDialogWorkspace"
-Range("B242").Value = 95
-Range("C242").Value = num
-B242 = Range("B242").Value
-C242 = Range("C242").Value
-If B242 = C242 Then
-Range("D242").Value = "OK"
-Else
-Range("D242").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogZoom(ByRef num)
-Range("A243").Clear
-Range("B243").Clear
-Range("C243").Clear
-Range("D243").Clear
-Range("A243").Value = "xlDialogZoom"
-Range("B243").Value = 256
-Range("C243").Value = num
-B243 = Range("B243").Value
-C243 = Range("C243").Value
-If B243 = C243 Then
-Range("D243").Value = "OK"
-Else
-Range("D243").Value = "NG"
-End If
-End Function
-
-<<<<<<
-======================
-Module4
->>>>>>
-Attribute VB_Name = "Module4"
-
-Sub main_4()
-test_xlErrDiv0 (xlErrDiv0)
-test_xlErrNA (xlErrNA)
-test_xlErrName (xlErrName)
-test_xlErrNull (xlErrNull)
-test_xlErrNum (xlErrNum)
-test_xlErrRef (xlErrRef)
-test_xlErrValue (xlErrValue)
-test_xlCalculatedMember (xlCalculatedMember)
-test_xlCalculatedSet (xlCalculatedSet)
-test_xlCalculationAutomatic (xlCalculationAutomatic)
-test_xlCalculationManual (xlCalculationManual)
-test_xlCalculationSemiautomatic (xlCalculationSemiautomatic)
-test_xlAnyKey (xlAnyKey)
-test_xlEscKey (xlEscKey)
-test_xlNoKey (xlNoKey)
-test_xlCalculating (xlCalculating)
-test_xlDone (xlDone)
-test_xlPending (xlPending)
-test_xlAutomaticScale (xlAutomaticScale)
-test_xlCategoryScale (xlCategoryScale)
-test_xlTimeScale (xlTimeScale)
-test_xlInsertDeleteCells (xlInsertDeleteCells)
-test_xlInsertEntireRows (xlInsertEntireRows)
-test_xlOverwriteCells (xlOverwriteCells)
-test_xlCellTypeAllFormatConditions (xlCellTypeAllFormatConditions)
-test_xlCellTypeAllValidation (xlCellTypeAllValidation)
-test_xlCellTypeBlanks (xlCellTypeBlanks)
-test_xlCellTypeComments (xlCellTypeComments)
-test_xlCellTypeConstants (xlCellTypeConstants)
-test_xlCellTypeFormulas (xlCellTypeFormulas)
-test_xlCellTypeLastCell (xlCellTypeLastCell)
-test_xlCellTypeSameFormatConditions (xlCellTypeSameFormatConditions)
-test_xlCellTypeSameValidation (xlCellTypeSameValidation)
-test_xlCellTypeVisible (xlCellTypeVisible)
-test_xlAnyGallery (xlAnyGallery)
-test_xlBuildIn (xlBuildIn)
-test_xlUserDefined (xlUserDefined)
-test_xlAxis (xlAxis)
-test_xlAxisTitle (xlAxisTitle)
-test_xlChartTitle (xlChartTitle)
-test_xlCorners (xlCorners)
-test_xlDataLabel (xlDataLabel)
-test_xlDataTable (xlDataTable)
-test_xlDisplayUnitLabel (xlDisplayUnitLabel)
-test_xlDownBars (xlDownBars)
-test_xlDropLines (xlDropLines)
-test_xlErrorBars (xlErrorBars)
-test_xlFloor (xlFloor)
-test_xlHiLoLines (xlHiLoLines)
-test_xlLeaderLines (xlLeaderLines)
-test_xlLegend (xlLegend)
-test_xlLegendEntry (xlLegendEntry)
-test_xlLegendKey (xlLegendKey)
-test_xlMajorGridlines (xlMajorGridlines)
-test_xlMinorGridlines (xlMinorGridlines)
-test_xlNothing (xlNothing)
-test_xlPivotChartDropZone (xlPivotChartDropZone)
-test_xlPivotChartFieldButton (xlPivotChartFieldButton)
-test_xlPlotArea (xlPlotArea)
-test_xlRaderAxisLabels (xlRaderAxisLabels)
-test_xlSeries (xlSeries)
-test_xlSeriesLines (xlSeriesLines)
-test_xlShape (xlShape)
-test_xlTrendline (xlTrendline)
-test_xlUpBars (xlUpBars)
-test_xlWalls (xlWalls)
-test_xlXErrorBars (xlXErrorBars)
-test_xlYErrorBars (xlYErrorBars)
-test_xlLocationAsNewSheet (xlLocationAsNewSheet)
-test_xlLocationAsObject (xlLocationAsObject)
-test_xlLocationAutomatic (xlLocationAutomatic)
-test_xlAllFaces (xlAllFaces)
-test_xlEnd (xlEnd)
-test_xlEndSides (xlEndSides)
-test_xlFront (xlFront)
-test_xlFrontEnd (xlFrontEnd)
-test_xlFrontSides (xlFrontSides)
-test_xlSlides (xlSlides)
-test_xlStack (xlStack)
-test_xlStackScale (xlStackScale)
-test_xlStretch (xlStretch)
-test_xlSplitByCustomSplit (xlSplitByCustomSplit)
-test_xlSplitByPercentValue (xlSplitByPercentValue)
-test_xlSplitByPercentPosition (xlSplitByPercentPosition)
-test_xlSplitByValue (xlSplitByValue)
-test_xl3DArea (xl3DArea)
-test_xl3DAreaStacked (xl3DAreaStacked)
-test_xl3DAreaStacked100 (xl3DAreaStacked100)
-test_xl3DBarClustered (xl3DBarClustered)
-test_xl3DBarStacked (xl3DBarStacked)
-test_xl3DBarStacked100 (xl3DBarStacked100)
-test_xl3DColumn (xl3DColumn)
-test_xl3DColumnClustered (xl3DColumnClustered)
-test_xl3DColumnStacked (xl3DColumnStacked)
-test_xl3DColumnStacked100 (xl3DColumnStacked100)
-test_xl3DLine (xl3DLine)
-test_xl3DPie (xl3DPie)
-test_xl3DPieExploded (xl3DPieExploded)
-test_xlArea (xlArea)
-test_xlAreaStacked (xlAreaStacked)
-test_xlAreaStacked100 (xlAreaStacked100)
-test_xlBarClustered (xlBarClustered)
-test_xlBarOfPie (xlBarOfPie)
-test_xlBarStacked (xlBarStacked)
-test_xlBarStacked100 (xlBarStacked100)
-test_xlBubble (xlBubble)
-test_xlBubble3DEffect (xlBubble3DEffect)
-test_xlColumnClustered (xlColumnClustered)
-test_xlColumnStacked (xlColumnStacked)
-test_xlColumnStacked100 (xlColumnStacked100)
-test_xlConeBarClustered (xlConeBarClustered)
-test_xlConeBarStacked (xlConeBarStacked)
-test_xlConeBarStacked100 (xlConeBarStacked100)
-test_xlConeCol (xlConeCol)
-test_xlConeColClustered (xlConeColClustered)
-test_xlConeColStacked (xlConeColStacked)
-test_xlConeColStacked100 (xlConeColStacked100)
-test_xlCylinderBarClustered (xlCylinderBarClustered)
-test_xlCylinderBarStacked (xlCylinderBarStacked)
-test_xlCylinderBarStacked100 (xlCylinderBarStacked100)
-test_xlCylinderCol (xlCylinderCol)
-test_xlCylinderColClustered (xlCylinderColClustered)
-test_xlCylinderColStacked (xlCylinderColStacked)
-test_xlCylinderColStacked100 (xlCylinderColStacked100)
-test_xlDoughnut (xlDoughnut)
-test_xlDoughnutExploded (xlDoughnutExploded)
-test_xlLine (xlLine)
-test_xlLineMarkers (xlLineMarkers)
-test_xlLineMarkersStacked (xlLineMarkersStacked)
-test_xlLineMarkersStacked100 (xlLineMarkersStacked100)
-test_xlLineStacked (xlLineStacked)
-test_xlLineStacked100 (xlLineStacked100)
-test_xlPie (xlPie)
-test_xlPieExploded (xlPieExploded)
-test_xlPieOfPie (xlPieOfPie)
-test_xlPyramidBarClustered (xlPyramidBarClustered)
-test_xlPyramidBarStacked (xlPyramidBarStacked)
-test_xlPyramidBarStacked100 (xlPyramidBarStacked100)
-test_xlPyramidCol (xlPyramidCol)
-test_xlPyramidColClustered (xlPyramidColClustered)
-test_xlPyramidColStacked (xlPyramidColStacked)
-test_xlPyramidColStacked100 (xlPyramidColStacked100)
-test_xlRader (xlRader)
-test_xlRaderFilled (xlRaderFilled)
-test_xlRaderMarkers (xlRaderMarkers)
-test_xlStockHLC (xlStockHLC)
-test_xlStockOHLC (xlStockOHLC)
-test_xlStockVHLC (xlStockVHLC)
-test_xlStockVOHLC (xlStockVOHLC)
-test_xlSurface (xlSurface)
-test_xlSurfaceTopView (xlSurfaceTopView)
-test_xlSurfaceTopViewWireframe (xlSurfaceTopViewWireframe)
-test_xlSurfaceWireframe (xlSurfaceWireframe)
-test_xlXYScatter (xlXYScatter)
-test_xlXYScatterLines (xlXYScatterLines)
-test_xlXYScatterLinesNoMarkers (xlXYScatterLinesNoMarkers)
-test_xlXYScatterSmooth (xlXYScatterSmooth)
-test_xlXYScatterSmoothNoMarkers (xlXYScatterSmoothNoMarkers)
-test_xlClipboardFormatBIFF (xlClipboardFormatBIFF)
-test_xlClipboardFormatBIFF2 (xlClipboardFormatBIFF2)
-test_xlClipboardFormatBIFF3 (xlClipboardFormatBIFF3)
-test_xlClipboardFormatBIFF4 (xlClipboardFormatBIFF4)
-test_xlClipboardFormatBinary (xlClipboardFormatBinary)
-test_xlClipboardFormatBitmap (xlClipboardFormatBitmap)
-test_xlClipboardFormatCGM (xlClipboardFormatCGM)
-test_xlClipboardFormatCSV (xlClipboardFormatCSV)
-test_xlClipboardFormatDIF (xlClipboardFormatDIF)
-test_xlClipboardFormatDspText (xlClipboardFormatDspText)
-test_xlClipboardFormatEmbeddedObject (xlClipboardFormatEmbeddedObject)
-test_xlClipboardFormatEmbedSource (xlClipboardFormatEmbedSource)
-test_xlClipboardFormatLink (xlClipboardFormatLink)
-test_xlClipboardFormatLinkSource (xlClipboardFormatLinkSource)
-test_xlClipboardFormatLinkSourceDesc (xlClipboardFormatLinkSourceDesc)
-test_xlClipboardFormatMovie (xlClipboardFormatMovie)
-test_xlClipboardFormatNative (xlClipboardFormatNative)
-test_xlClipboardFormatObjectDesc (xlClipboardFormatObjectDesc)
-test_xlClipboardFormatObjectLink (xlClipboardFormatObjectLink)
-test_xlClipboardFormatOwnerLink (xlClipboardFormatOwnerLink)
-test_xlClipboardFormatPICT (xlClipboardFormatPICT)
-test_xlClipboardFormatPrintPICT (xlClipboardFormatPrintPICT)
-test_xlClipboardFormatRTF (xlClipboardFormatRTF)
-test_xlClipboardFormatScreenPICT (xlClipboardFormatScreenPICT)
-test_xlClipboardFormatStandardFont (xlClipboardFormatStandardFont)
-test_xlClipboardFormatStandardScale (xlClipboardFormatStandardScale)
-test_xlClipboardFormatSYLK (xlClipboardFormatSYLK)
-test_xlClipboardFormatTable (xlClipboardFormatTable)
-test_xlClipboardFormatText (xlClipboardFormatText)
-test_xlClipboardFormatToolFace (xlClipboardFormatToolFace)
-test_xlClipboardFormatToolFacePICT (xlClipboardFormatToolFacePICT)
-test_xlClipboardFormatToolVALU (xlClipboardFormatToolVALU)
-test_xlClipboardFormatToolWK1 (xlClipboardFormatToolWK1)
-test_xlCmdCube (xlCmdCube)
-test_xlCmdDefault (xlCmdDefault)
-test_xlCmdList (xlCmdList)
-test_xlCmdSql (xlCmdSql)
-test_xlCmdTable (xlCmdTable)
-test_xlColorIndexAutomatic (xlColorIndexAutomatic)
-test_xlColorIndexNone (xlColorIndexNone)
-test_xlDMYFormat (xlDMYFormat)
-test_xlDYMFormat (xlDYMFormat)
-test_xlEMDFormat (xlEMDFormat)
-test_xlGeneralFormat (xlGeneralFormat)
-test_xlMDYFormat (xlMDYFormat)
-test_xlMYDFormat (xlMYDFormat)
-test_xlSkipColumn (xlSkipColumn)
-test_xlTextFormat (xlTextFormat)
-test_xlYDMFormat (xlYDMFormat)
-test_xlYMDFormat (xlYMDFormat)
-test_xlCommandUnderlinesAutomatic (xlCommandUnderlinesAutomatic)
-test_xlCommandUnderlinesOff (xlCommandUnderlinesOff)
-test_xlCommandUnderlinesOn (xlCommandUnderlinesOn)
-test_xlCommentAndIndicator (xlCommentAndIndicator)
-test_xlCommentIndicatorOnly (xlCommentIndicatorOnly)
-test_xlNoIndicator (xlNoIndicator)
-test_xlAverage (xlAverage)
-test_xlCount (xlCount)
-test_xlCountNums (xlCountNums)
-test_xlMax (xlMax)
-test_xlMin (xlMin)
-test_xlProduct (xlProduct)
-test_xlStDev (xlStDev)
-test_xlStDevP (xlStDevP)
-test_xlSum (xlSum)
-test_xlUnknown (xlUnknown)
-test_xlVar (xlVar)
-test_xlVarP (xlVarP)
-test_xlBitmap (xlBitmap)
-test_xlPicture (xlPicture)
-test_xlExtractData (xlExtractData)
-test_xlNormalLoad (xlNormalLoad)
-test_xlRepairFile (xlRepairFile)
-test_xlCreatorCode (xlCreatorCode)
-test_xlHierarchy (xlHierarchy)
-test_xlMeasure (xlMeasure)
-test_xlSet (xlSet)
-test_xlCopy (xlCopy)
-test_xlCut (xlCut)
-test_xlValidAlterInformation (xlValidAlterInformation)
-test_xlValidAlterStop (xlValidAlterStop)
-test_xlValidAlterWarning (xlValidAlterWarning)
-test_xlValidateCustom (xlValidateCustom)
-test_xlValidateDate (xlValidateDate)
-test_xlValidateDecimal (xlValidateDecimal)
-test_xlValidateInputOnly (xlValidateInputOnly)
-test_xlValidateList (xlValidateList)
-test_xlValidateTextLength (xlValidateTextLength)
-test_xlValidateTime (xlValidateTime)
-test_xlValidateWholeNumber (xlValidateWholeNumber)
-test_xlLabelPositionAbove (xlLabelPositionAbove)
-test_xlLabelPositionBelow (xlLabelPositionBelow)
-test_xlLabelPositionBestFit (xlLabelPositionBestFit)
-test_xlLabelPositionBestCenter (xlLabelPositionBestCenter)
-test_xlLabelPositionBestCustom (xlLabelPositionBestCustom)
-test_xlLabelPositionInsideBase (xlLabelPositionInsideBase)
-test_xlLabelPositionInsideEnd (xlLabelPositionInsideEnd)
-test_xlLabelPositionInsideLeft (xlLabelPositionInsideLeft)
-test_xlLabelPositionMixed (xlLabelPositionMixed)
-test_xlLabelPositionOutsideEnd (xlLabelPositionOutsideEnd)
-test_xlLabelPositionRight (xlLabelPositionRight)
-test_xlDataLabelSeparatorDefault (xlDataLabelSeparatorDefault)
-test_xlDataLabelsShowBubbleSizes (xlDataLabelsShowBubbleSizes)
-test_xlDataLabelsShowLabel (xlDataLabelsShowLabel)
-test_xlDataLabelsShowLabelAndPercent (xlDataLabelsShowLabelAndPercent)
-test_xlDataLabelsShowNone (xlDataLabelsShowNone)
-test_xlDataLabelsShowPercent (xlDataLabelsShowPercent)
-test_xlDataLabelsShowValue (xlDataLabelsShowValue)
-test_xlDay (xlDay)
-test_xlMonth (xlMonth)
-test_xlWeekday (xlWeekday)
-test_xlYear (xlYear)
-test_xlAutoFill (xlAutoFill)
-test_xlChronological (xlChronological)
-test_xlDataSeriesLinear (xlDataSeriesLinear)
-test_xlGrowth (xlGrowth)
-test_xlShiftToLeft (xlShiftToLeft)
-test_xlShiftUp (xlShiftUp)
-test_xlDown (xlDown)
-test_xlToLeft (xlToLeft)
-test_xlToRight (xlToRight)
-test_xlUp (xlUp)
-test_xlInterpolated (xlInterpolated)
-test_xlNotPlotted (xlNotPlotted)
-test_xlZero (xlZero)
-test_xlDisplayShapes (xlDisplayShapes)
-test_xlHide (xlHide)
-test_xlPlaceholders (xlPlaceholders)
-test_xlHundredMillions (xlHundredMillions)
-test_xlHundreds (xlHundreds)
-test_xlHundredThousands (xlHundredThousands)
-test_xlMillionMillons (xlMillionMillons)
-test_xlMillions (xlMillions)
-test_xlTenMillions (xlTenMillions)
-test_xlTenThousands (xlTenThousands)
-test_xlThousandMillions (xlThousandMillions)
-test_xlThousands (xlThousands)
-Range("A1").Value = "constant name"
-Range("B1").Value = "OOo result"
-Range("C1").Value = "Excel result"
-Range("D1").Value = "Correct?"
-End Sub
-
-Function test_xlErrDiv0(ByRef num)
-Range("A2").Clear
-Range("B2").Clear
-Range("C2").Clear
-Range("D2").Clear
-Range("A2").Value = "xlErrDiv0"
-Range("B2").Value = 2007
-Range("C2").Value = num
-B2 = Range("B2").Value
-C2 = Range("C2").Value
-If B2 = C2 Then
-Range("D2").Value = "OK"
-Else
-Range("D2").Value = "NG"
-End If
-End Function
-
-Function test_xlErrNA(ByRef num)
-Range("A3").Clear
-Range("B3").Clear
-Range("C3").Clear
-Range("D3").Clear
-Range("A3").Value = "xlErrNA"
-Range("B3").Value = 2042
-Range("C3").Value = num
-B3 = Range("B3").Value
-C3 = Range("C3").Value
-If B3 = C3 Then
-Range("D3").Value = "OK"
-Else
-Range("D3").Value = "NG"
-End If
-End Function
-
-Function test_xlErrName(ByRef num)
-Range("A4").Clear
-Range("B4").Clear
-Range("C4").Clear
-Range("D4").Clear
-Range("A4").Value = "xlErrName"
-Range("B4").Value = 2029
-Range("C4").Value = num
-B4 = Range("B4").Value
-C4 = Range("C4").Value
-If B4 = C4 Then
-Range("D4").Value = "OK"
-Else
-Range("D4").Value = "NG"
-End If
-End Function
-
-Function test_xlErrNull(ByRef num)
-Range("A5").Clear
-Range("B5").Clear
-Range("C5").Clear
-Range("D5").Clear
-Range("A5").Value = "xlErrNull"
-Range("B5").Value = 2000
-Range("C5").Value = num
-B5 = Range("B5").Value
-C5 = Range("C5").Value
-If B5 = C5 Then
-Range("D5").Value = "OK"
-Else
-Range("D5").Value = "NG"
-End If
-End Function
-
-Function test_xlErrNum(ByRef num)
-Range("A6").Clear
-Range("B6").Clear
-Range("C6").Clear
-Range("D6").Clear
-Range("A6").Value = "xlErrNum"
-Range("B6").Value = 2036
-Range("C6").Value = num
-B6 = Range("B6").Value
-C6 = Range("C6").Value
-If B6 = C6 Then
-Range("D6").Value = "OK"
-Else
-Range("D6").Value = "NG"
-End If
-End Function
-
-Function test_xlErrRef(ByRef num)
-Range("A7").Clear
-Range("B7").Clear
-Range("C7").Clear
-Range("D7").Clear
-Range("A7").Value = "xlErrRef"
-Range("B7").Value = 2023
-Range("C7").Value = num
-B7 = Range("B7").Value
-C7 = Range("C7").Value
-If B7 = C7 Then
-Range("D7").Value = "OK"
-Else
-Range("D7").Value = "NG"
-End If
-End Function
-
-Function test_xlErrValue(ByRef num)
-Range("A8").Clear
-Range("B8").Clear
-Range("C8").Clear
-Range("D8").Clear
-Range("A8").Value = "xlErrValue"
-Range("B8").Value = 2015
-Range("C8").Value = num
-B8 = Range("B8").Value
-C8 = Range("C8").Value
-If B8 = C8 Then
-Range("D8").Value = "OK"
-Else
-Range("D8").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculatedMember(ByRef num)
-Range("A9").Clear
-Range("B9").Clear
-Range("C9").Clear
-Range("D9").Clear
-Range("A9").Value = "xlCalculatedMember"
-Range("B9").Value = 0
-Range("C9").Value = num
-B9 = Range("B9").Value
-C9 = Range("C9").Value
-If B9 = C9 Then
-Range("D9").Value = "OK"
-Else
-Range("D9").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculatedSet(ByRef num)
-Range("A10").Clear
-Range("B10").Clear
-Range("C10").Clear
-Range("D10").Clear
-Range("A10").Value = "xlCalculatedSet"
-Range("B10").Value = 1
-Range("C10").Value = num
-B10 = Range("B10").Value
-C10 = Range("C10").Value
-If B10 = C10 Then
-Range("D10").Value = "OK"
-Else
-Range("D10").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculationAutomatic(ByRef num)
-Range("A11").Clear
-Range("B11").Clear
-Range("C11").Clear
-Range("D11").Clear
-Range("A11").Value = "xlCalculationAutomatic"
-Range("B11").Value = -4105
-Range("C11").Value = num
-B11 = Range("B11").Value
-C11 = Range("C11").Value
-If B11 = C11 Then
-Range("D11").Value = "OK"
-Else
-Range("D11").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculationManual(ByRef num)
-Range("A12").Clear
-Range("B12").Clear
-Range("C12").Clear
-Range("D12").Clear
-Range("A12").Value = "xlCalculationManual"
-Range("B12").Value = -4135
-Range("C12").Value = num
-B12 = Range("B12").Value
-C12 = Range("C12").Value
-If B12 = C12 Then
-Range("D12").Value = "OK"
-Else
-Range("D12").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculationSemiautomatic(ByRef num)
-Range("A13").Clear
-Range("B13").Clear
-Range("C13").Clear
-Range("D13").Clear
-Range("A13").Value = "xlCalculationSemiautomatic"
-Range("B13").Value = 2
-Range("C13").Value = num
-B13 = Range("B13").Value
-C13 = Range("C13").Value
-If B13 = C13 Then
-Range("D13").Value = "OK"
-Else
-Range("D13").Value = "NG"
-End If
-End Function
-
-Function test_xlAnyKey(ByRef num)
-Range("A14").Clear
-Range("B14").Clear
-Range("C14").Clear
-Range("D14").Clear
-Range("A14").Value = "xlAnyKey"
-Range("B14").Value = 2
-Range("C14").Value = num
-B14 = Range("B14").Value
-C14 = Range("C14").Value
-If B14 = C14 Then
-Range("D14").Value = "OK"
-Else
-Range("D14").Value = "NG"
-End If
-End Function
-
-Function test_xlEscKey(ByRef num)
-Range("A15").Clear
-Range("B15").Clear
-Range("C15").Clear
-Range("D15").Clear
-Range("A15").Value = "xlEscKey"
-Range("B15").Value = 1
-Range("C15").Value = num
-B15 = Range("B15").Value
-C15 = Range("C15").Value
-If B15 = C15 Then
-Range("D15").Value = "OK"
-Else
-Range("D15").Value = "NG"
-End If
-End Function
-
-Function test_xlNoKey(ByRef num)
-Range("A16").Clear
-Range("B16").Clear
-Range("C16").Clear
-Range("D16").Clear
-Range("A16").Value = "xlNoKey"
-Range("B16").Value = 0
-Range("C16").Value = num
-B16 = Range("B16").Value
-C16 = Range("C16").Value
-If B16 = C16 Then
-Range("D16").Value = "OK"
-Else
-Range("D16").Value = "NG"
-End If
-End Function
-
-Function test_xlCalculating(ByRef num)
-Range("A17").Clear
-Range("B17").Clear
-Range("C17").Clear
-Range("D17").Clear
-Range("A17").Value = "xlCalculating"
-Range("B17").Value = 1
-Range("C17").Value = num
-B17 = Range("B17").Value
-C17 = Range("C17").Value
-If B17 = C17 Then
-Range("D17").Value = "OK"
-Else
-Range("D17").Value = "NG"
-End If
-End Function
-
-Function test_xlDone(ByRef num)
-Range("A18").Clear
-Range("B18").Clear
-Range("C18").Clear
-Range("D18").Clear
-Range("A18").Value = "xlDone"
-Range("B18").Value = 0
-Range("C18").Value = num
-B18 = Range("B18").Value
-C18 = Range("C18").Value
-If B18 = C18 Then
-Range("D18").Value = "OK"
-Else
-Range("D18").Value = "NG"
-End If
-End Function
-
-Function test_xlPending(ByRef num)
-Range("A19").Clear
-Range("B19").Clear
-Range("C19").Clear
-Range("D19").Clear
-Range("A19").Value = "xlPending"
-Range("B19").Value = 2
-Range("C19").Value = num
-B19 = Range("B19").Value
-C19 = Range("C19").Value
-If B19 = C19 Then
-Range("D19").Value = "OK"
-Else
-Range("D19").Value = "NG"
-End If
-End Function
-
-Function test_xlAutomaticScale(ByRef num)
-Range("A20").Clear
-Range("B20").Clear
-Range("C20").Clear
-Range("D20").Clear
-Range("A20").Value = "xlAutomaticScale"
-Range("B20").Value = -4105
-Range("C20").Value = num
-B20 = Range("B20").Value
-C20 = Range("C20").Value
-If B20 = C20 Then
-Range("D20").Value = "OK"
-Else
-Range("D20").Value = "NG"
-End If
-End Function
-
-Function test_xlCategoryScale(ByRef num)
-Range("A21").Clear
-Range("B21").Clear
-Range("C21").Clear
-Range("D21").Clear
-Range("A21").Value = "xlCategoryScale"
-Range("B21").Value = 2
-Range("C21").Value = num
-B21 = Range("B21").Value
-C21 = Range("C21").Value
-If B21 = C21 Then
-Range("D21").Value = "OK"
-Else
-Range("D21").Value = "NG"
-End If
-End Function
-
-Function test_xlTimeScale(ByRef num)
-Range("A22").Clear
-Range("B22").Clear
-Range("C22").Clear
-Range("D22").Clear
-Range("A22").Value = "xlTimeScale"
-Range("B22").Value = 3
-Range("C22").Value = num
-B22 = Range("B22").Value
-C22 = Range("C22").Value
-If B22 = C22 Then
-Range("D22").Value = "OK"
-Else
-Range("D22").Value = "NG"
-End If
-End Function
-
-Function test_xlInsertDeleteCells(ByRef num)
-Range("A23").Clear
-Range("B23").Clear
-Range("C23").Clear
-Range("D23").Clear
-Range("A23").Value = "xlInsertDeleteCells"
-Range("B23").Value = 1
-Range("C23").Value = num
-B23 = Range("B23").Value
-C23 = Range("C23").Value
-If B23 = C23 Then
-Range("D23").Value = "OK"
-Else
-Range("D23").Value = "NG"
-End If
-End Function
-
-Function test_xlInsertEntireRows(ByRef num)
-Range("A24").Clear
-Range("B24").Clear
-Range("C24").Clear
-Range("D24").Clear
-Range("A24").Value = "xlInsertEntireRows"
-Range("B24").Value = 2
-Range("C24").Value = num
-B24 = Range("B24").Value
-C24 = Range("C24").Value
-If B24 = C24 Then
-Range("D24").Value = "OK"
-Else
-Range("D24").Value = "NG"
-End If
-End Function
-
-Function test_xlOverwriteCells(ByRef num)
-Range("A25").Clear
-Range("B25").Clear
-Range("C25").Clear
-Range("D25").Clear
-Range("A25").Value = "xlOverwriteCells"
-Range("B25").Value = 0
-Range("C25").Value = num
-B25 = Range("B25").Value
-C25 = Range("C25").Value
-If B25 = C25 Then
-Range("D25").Value = "OK"
-Else
-Range("D25").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeAllFormatConditions(ByRef num)
-Range("A26").Clear
-Range("B26").Clear
-Range("C26").Clear
-Range("D26").Clear
-Range("A26").Value = "xlCellTypeAllFormatConditions"
-Range("B26").Value = -4172
-Range("C26").Value = num
-B26 = Range("B26").Value
-C26 = Range("C26").Value
-If B26 = C26 Then
-Range("D26").Value = "OK"
-Else
-Range("D26").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeAllValidation(ByRef num)
-Range("A27").Clear
-Range("B27").Clear
-Range("C27").Clear
-Range("D27").Clear
-Range("A27").Value = "xlCellTypeAllValidation"
-Range("B27").Value = -4174
-Range("C27").Value = num
-B27 = Range("B27").Value
-C27 = Range("C27").Value
-If B27 = C27 Then
-Range("D27").Value = "OK"
-Else
-Range("D27").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeBlanks(ByRef num)
-Range("A28").Clear
-Range("B28").Clear
-Range("C28").Clear
-Range("D28").Clear
-Range("A28").Value = "xlCellTypeBlanks"
-Range("B28").Value = 4
-Range("C28").Value = num
-B28 = Range("B28").Value
-C28 = Range("C28").Value
-If B28 = C28 Then
-Range("D28").Value = "OK"
-Else
-Range("D28").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeComments(ByRef num)
-Range("A29").Clear
-Range("B29").Clear
-Range("C29").Clear
-Range("D29").Clear
-Range("A29").Value = "xlCellTypeComments"
-Range("B29").Value = -4144
-Range("C29").Value = num
-B29 = Range("B29").Value
-C29 = Range("C29").Value
-If B29 = C29 Then
-Range("D29").Value = "OK"
-Else
-Range("D29").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeConstants(ByRef num)
-Range("A30").Clear
-Range("B30").Clear
-Range("C30").Clear
-Range("D30").Clear
-Range("A30").Value = "xlCellTypeConstants"
-Range("B30").Value = 2
-Range("C30").Value = num
-B30 = Range("B30").Value
-C30 = Range("C30").Value
-If B30 = C30 Then
-Range("D30").Value = "OK"
-Else
-Range("D30").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeFormulas(ByRef num)
-Range("A31").Clear
-Range("B31").Clear
-Range("C31").Clear
-Range("D31").Clear
-Range("A31").Value = "xlCellTypeFormulas"
-Range("B31").Value = -4123
-Range("C31").Value = num
-B31 = Range("B31").Value
-C31 = Range("C31").Value
-If B31 = C31 Then
-Range("D31").Value = "OK"
-Else
-Range("D31").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeLastCell(ByRef num)
-Range("A32").Clear
-Range("B32").Clear
-Range("C32").Clear
-Range("D32").Clear
-Range("A32").Value = "xlCellTypeLastCell"
-Range("B32").Value = 11
-Range("C32").Value = num
-B32 = Range("B32").Value
-C32 = Range("C32").Value
-If B32 = C32 Then
-Range("D32").Value = "OK"
-Else
-Range("D32").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeSameFormatConditions(ByRef num)
-Range("A33").Clear
-Range("B33").Clear
-Range("C33").Clear
-Range("D33").Clear
-Range("A33").Value = "xlCellTypeSameFormatConditions"
-Range("B33").Value = -4173
-Range("C33").Value = num
-B33 = Range("B33").Value
-C33 = Range("C33").Value
-If B33 = C33 Then
-Range("D33").Value = "OK"
-Else
-Range("D33").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeSameValidation(ByRef num)
-Range("A34").Clear
-Range("B34").Clear
-Range("C34").Clear
-Range("D34").Clear
-Range("A34").Value = "xlCellTypeSameValidation"
-Range("B34").Value = -4175
-Range("C34").Value = num
-B34 = Range("B34").Value
-C34 = Range("C34").Value
-If B34 = C34 Then
-Range("D34").Value = "OK"
-Else
-Range("D34").Value = "NG"
-End If
-End Function
-
-Function test_xlCellTypeVisible(ByRef num)
-Range("A35").Clear
-Range("B35").Clear
-Range("C35").Clear
-Range("D35").Clear
-Range("A35").Value = "xlCellTypeVisible"
-Range("B35").Value = 12
-Range("C35").Value = num
-B35 = Range("B35").Value
-C35 = Range("C35").Value
-If B35 = C35 Then
-Range("D35").Value = "OK"
-Else
-Range("D35").Value = "NG"
-End If
-End Function
-
-Function test_xlAnyGallery(ByRef num)
-Range("A36").Clear
-Range("B36").Clear
-Range("C36").Clear
-Range("D36").Clear
-Range("A36").Value = "xlAnyGallery"
-Range("B36").Value = 23
-Range("C36").Value = num
-B36 = Range("B36").Value
-C36 = Range("C36").Value
-If B36 = C36 Then
-Range("D36").Value = "OK"
-Else
-Range("D36").Value = "NG"
-End If
-End Function
-
-Function test_xlBuildIn(ByRef num)
-Range("A37").Clear
-Range("B37").Clear
-Range("C37").Clear
-Range("D37").Clear
-Range("A37").Value = "xlBuildIn"
-Range("B37").Value = 21
-Range("C37").Value = num
-B37 = Range("B37").Value
-C37 = Range("C37").Value
-If B37 = C37 Then
-Range("D37").Value = "OK"
-Else
-Range("D37").Value = "NG"
-End If
-End Function
-
-Function test_xlUserDefined(ByRef num)
-Range("A38").Clear
-Range("B38").Clear
-Range("C38").Clear
-Range("D38").Clear
-Range("A38").Value = "xlUserDefined"
-Range("B38").Value = 22
-Range("C38").Value = num
-B38 = Range("B38").Value
-C38 = Range("C38").Value
-If B38 = C38 Then
-Range("D38").Value = "OK"
-Else
-Range("D38").Value = "NG"
-End If
-End Function
-
-Function test_xlAxis(ByRef num)
-Range("A39").Clear
-Range("B39").Clear
-Range("C39").Clear
-Range("D39").Clear
-Range("A39").Value = "xlAxis"
-Range("B39").Value = 21
-Range("C39").Value = num
-B39 = Range("B39").Value
-C39 = Range("C39").Value
-If B39 = C39 Then
-Range("D39").Value = "OK"
-Else
-Range("D39").Value = "NG"
-End If
-End Function
-
-Function test_xlAxisTitle(ByRef num)
-Range("A40").Clear
-Range("B40").Clear
-Range("C40").Clear
-Range("D40").Clear
-Range("A40").Value = "xlAxisTitle"
-Range("B40").Value = 17
-Range("C40").Value = num
-B40 = Range("B40").Value
-C40 = Range("C40").Value
-If B40 = C40 Then
-Range("D40").Value = "OK"
-Else
-Range("D40").Value = "NG"
-End If
-End Function
-
-Function test_xlChartTitle(ByRef num)
-Range("A41").Clear
-Range("B41").Clear
-Range("C41").Clear
-Range("D41").Clear
-Range("A41").Value = "xlChartTitle"
-Range("B41").Value = 4
-Range("C41").Value = num
-B41 = Range("B41").Value
-C41 = Range("C41").Value
-If B41 = C41 Then
-Range("D41").Value = "OK"
-Else
-Range("D41").Value = "NG"
-End If
-End Function
-
-Function test_xlCorners(ByRef num)
-Range("A42").Clear
-Range("B42").Clear
-Range("C42").Clear
-Range("D42").Clear
-Range("A42").Value = "xlCorners"
-Range("B42").Value = 6
-Range("C42").Value = num
-B42 = Range("B42").Value
-C42 = Range("C42").Value
-If B42 = C42 Then
-Range("D42").Value = "OK"
-Else
-Range("D42").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabel(ByRef num)
-Range("A43").Clear
-Range("B43").Clear
-Range("C43").Clear
-Range("D43").Clear
-Range("A43").Value = "xlDataLabel"
-Range("B43").Value = 0
-Range("C43").Value = num
-B43 = Range("B43").Value
-C43 = Range("C43").Value
-If B43 = C43 Then
-Range("D43").Value = "OK"
-Else
-Range("D43").Value = "NG"
-End If
-End Function
-
-Function test_xlDataTable(ByRef num)
-Range("A44").Clear
-Range("B44").Clear
-Range("C44").Clear
-Range("D44").Clear
-Range("A44").Value = "xlDataTable"
-Range("B44").Value = 0
-Range("C44").Value = num
-B44 = Range("B44").Value
-C44 = Range("C44").Value
-If B44 = C44 Then
-Range("D44").Value = "OK"
-Else
-Range("D44").Value = "NG"
-End If
-End Function
-
-Function test_xlDisplayUnitLabel(ByRef num)
-Range("A45").Clear
-Range("B45").Clear
-Range("C45").Clear
-Range("D45").Clear
-Range("A45").Value = "xlDisplayUnitLabel"
-Range("B45").Value = 30
-Range("C45").Value = num
-B45 = Range("B45").Value
-C45 = Range("C45").Value
-If B45 = C45 Then
-Range("D45").Value = "OK"
-Else
-Range("D45").Value = "NG"
-End If
-End Function
-
-Function test_xlDownBars(ByRef num)
-Range("A46").Clear
-Range("B46").Clear
-Range("C46").Clear
-Range("D46").Clear
-Range("A46").Value = "xlDownBars"
-Range("B46").Value = 20
-Range("C46").Value = num
-B46 = Range("B46").Value
-C46 = Range("C46").Value
-If B46 = C46 Then
-Range("D46").Value = "OK"
-Else
-Range("D46").Value = "NG"
-End If
-End Function
-
-Function test_xlDropLines(ByRef num)
-Range("A47").Clear
-Range("B47").Clear
-Range("C47").Clear
-Range("D47").Clear
-Range("A47").Value = "xlDropLines"
-Range("B47").Value = 26
-Range("C47").Value = num
-B47 = Range("B47").Value
-C47 = Range("C47").Value
-If B47 = C47 Then
-Range("D47").Value = "OK"
-Else
-Range("D47").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBars(ByRef num)
-Range("A48").Clear
-Range("B48").Clear
-Range("C48").Clear
-Range("D48").Clear
-Range("A48").Value = "xlErrorBars"
-Range("B48").Value = 9
-Range("C48").Value = num
-B48 = Range("B48").Value
-C48 = Range("C48").Value
-If B48 = C48 Then
-Range("D48").Value = "OK"
-Else
-Range("D48").Value = "NG"
-End If
-End Function
-
-Function test_xlFloor(ByRef num)
-Range("A49").Clear
-Range("B49").Clear
-Range("C49").Clear
-Range("D49").Clear
-Range("A49").Value = "xlFloor"
-Range("B49").Value = 23
-Range("C49").Value = num
-B49 = Range("B49").Value
-C49 = Range("C49").Value
-If B49 = C49 Then
-Range("D49").Value = "OK"
-Else
-Range("D49").Value = "NG"
-End If
-End Function
-
-Function test_xlHiLoLines(ByRef num)
-Range("A50").Clear
-Range("B50").Clear
-Range("C50").Clear
-Range("D50").Clear
-Range("A50").Value = "xlHiLoLines"
-Range("B50").Value = 25
-Range("C50").Value = num
-B50 = Range("B50").Value
-C50 = Range("C50").Value
-If B50 = C50 Then
-Range("D50").Value = "OK"
-Else
-Range("D50").Value = "NG"
-End If
-End Function
-
-Function test_xlLeaderLines(ByRef num)
-Range("A51").Clear
-Range("B51").Clear
-Range("C51").Clear
-Range("D51").Clear
-Range("A51").Value = "xlLeaderLines"
-Range("B51").Value = 29
-Range("C51").Value = num
-B51 = Range("B51").Value
-C51 = Range("C51").Value
-If B51 = C51 Then
-Range("D51").Value = "OK"
-Else
-Range("D51").Value = "NG"
-End If
-End Function
-
-Function test_xlLegend(ByRef num)
-Range("A52").Clear
-Range("B52").Clear
-Range("C52").Clear
-Range("D52").Clear
-Range("A52").Value = "xlLegend"
-Range("B52").Value = 24
-Range("C52").Value = num
-B52 = Range("B52").Value
-C52 = Range("C52").Value
-If B52 = C52 Then
-Range("D52").Value = "OK"
-Else
-Range("D52").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendEntry(ByRef num)
-Range("A53").Clear
-Range("B53").Clear
-Range("C53").Clear
-Range("D53").Clear
-Range("A53").Value = "xlLegendEntry"
-Range("B53").Value = 12
-Range("C53").Value = num
-B53 = Range("B53").Value
-C53 = Range("C53").Value
-If B53 = C53 Then
-Range("D53").Value = "OK"
-Else
-Range("D53").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendKey(ByRef num)
-Range("A54").Clear
-Range("B54").Clear
-Range("C54").Clear
-Range("D54").Clear
-Range("A54").Value = "xlLegendKey"
-Range("B54").Value = 13
-Range("C54").Value = num
-B54 = Range("B54").Value
-C54 = Range("C54").Value
-If B54 = C54 Then
-Range("D54").Value = "OK"
-Else
-Range("D54").Value = "NG"
-End If
-End Function
-
-Function test_xlMajorGridlines(ByRef num)
-Range("A55").Clear
-Range("B55").Clear
-Range("C55").Clear
-Range("D55").Clear
-Range("A55").Value = "xlMajorGridlines"
-Range("B55").Value = 15
-Range("C55").Value = num
-B55 = Range("B55").Value
-C55 = Range("C55").Value
-If B55 = C55 Then
-Range("D55").Value = "OK"
-Else
-Range("D55").Value = "NG"
-End If
-End Function
-
-Function test_xlMinorGridlines(ByRef num)
-Range("A56").Clear
-Range("B56").Clear
-Range("C56").Clear
-Range("D56").Clear
-Range("A56").Value = "xlMinorGridlines"
-Range("B56").Value = 16
-Range("C56").Value = num
-B56 = Range("B56").Value
-C56 = Range("C56").Value
-If B56 = C56 Then
-Range("D56").Value = "OK"
-Else
-Range("D56").Value = "NG"
-End If
-End Function
-
-Function test_xlNothing(ByRef num)
-Range("A57").Clear
-Range("B57").Clear
-Range("C57").Clear
-Range("D57").Clear
-Range("A57").Value = "xlNothing"
-Range("B57").Value = 28
-Range("C57").Value = num
-B57 = Range("B57").Value
-C57 = Range("C57").Value
-If B57 = C57 Then
-Range("D57").Value = "OK"
-Else
-Range("D57").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotChartDropZone(ByRef num)
-Range("A58").Clear
-Range("B58").Clear
-Range("C58").Clear
-Range("D58").Clear
-Range("A58").Value = "xlPivotChartDropZone"
-Range("B58").Value = 32
-Range("C58").Value = num
-B58 = Range("B58").Value
-C58 = Range("C58").Value
-If B58 = C58 Then
-Range("D58").Value = "OK"
-Else
-Range("D58").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotChartFieldButton(ByRef num)
-Range("A59").Clear
-Range("B59").Clear
-Range("C59").Clear
-Range("D59").Clear
-Range("A59").Value = "xlPivotChartFieldButton"
-Range("B59").Value = 31
-Range("C59").Value = num
-B59 = Range("B59").Value
-C59 = Range("C59").Value
-If B59 = C59 Then
-Range("D59").Value = "OK"
-Else
-Range("D59").Value = "NG"
-End If
-End Function
-
-Function test_xlPlotArea(ByRef num)
-Range("A60").Clear
-Range("B60").Clear
-Range("C60").Clear
-Range("D60").Clear
-Range("A60").Value = "xlPlotArea"
-Range("B60").Value = 19
-Range("C60").Value = num
-B60 = Range("B60").Value
-C60 = Range("C60").Value
-If B60 = C60 Then
-Range("D60").Value = "OK"
-Else
-Range("D60").Value = "NG"
-End If
-End Function
-
-Function test_xlRaderAxisLabels(ByRef num)
-Range("A61").Clear
-Range("B61").Clear
-Range("C61").Clear
-Range("D61").Clear
-Range("A61").Value = "xlRaderAxisLabels"
-Range("B61").Value = 27
-Range("C61").Value = num
-B61 = Range("B61").Value
-C61 = Range("C61").Value
-If B61 = C61 Then
-Range("D61").Value = "OK"
-Else
-Range("D61").Value = "NG"
-End If
-End Function
-
-Function test_xlSeries(ByRef num)
-Range("A62").Clear
-Range("B62").Clear
-Range("C62").Clear
-Range("D62").Clear
-Range("A62").Value = "xlSeries"
-Range("B62").Value = 3
-Range("C62").Value = num
-B62 = Range("B62").Value
-C62 = Range("C62").Value
-If B62 = C62 Then
-Range("D62").Value = "OK"
-Else
-Range("D62").Value = "NG"
-End If
-End Function
-
-Function test_xlSeriesLines(ByRef num)
-Range("A63").Clear
-Range("B63").Clear
-Range("C63").Clear
-Range("D63").Clear
-Range("A63").Value = "xlSeriesLines"
-Range("B63").Value = 22
-Range("C63").Value = num
-B63 = Range("B63").Value
-C63 = Range("C63").Value
-If B63 = C63 Then
-Range("D63").Value = "OK"
-Else
-Range("D63").Value = "NG"
-End If
-End Function
-
-Function test_xlShape(ByRef num)
-Range("A64").Clear
-Range("B64").Clear
-Range("C64").Clear
-Range("D64").Clear
-Range("A64").Value = "xlShape"
-Range("B64").Value = 14
-Range("C64").Value = num
-B64 = Range("B64").Value
-C64 = Range("C64").Value
-If B64 = C64 Then
-Range("D64").Value = "OK"
-Else
-Range("D64").Value = "NG"
-End If
-End Function
-
-Function test_xlTrendline(ByRef num)
-Range("A65").Clear
-Range("B65").Clear
-Range("C65").Clear
-Range("D65").Clear
-Range("A65").Value = "xlTrendline"
-Range("B65").Value = 8
-Range("C65").Value = num
-B65 = Range("B65").Value
-C65 = Range("C65").Value
-If B65 = C65 Then
-Range("D65").Value = "OK"
-Else
-Range("D65").Value = "NG"
-End If
-End Function
-
-Function test_xlUpBars(ByRef num)
-Range("A66").Clear
-Range("B66").Clear
-Range("C66").Clear
-Range("D66").Clear
-Range("A66").Value = "xlUpBars"
-Range("B66").Value = 18
-Range("C66").Value = num
-B66 = Range("B66").Value
-C66 = Range("C66").Value
-If B66 = C66 Then
-Range("D66").Value = "OK"
-Else
-Range("D66").Value = "NG"
-End If
-End Function
-
-Function test_xlWalls(ByRef num)
-Range("A67").Clear
-Range("B67").Clear
-Range("C67").Clear
-Range("D67").Clear
-Range("A67").Value = "xlWalls"
-Range("B67").Value = 5
-Range("C67").Value = num
-B67 = Range("B67").Value
-C67 = Range("C67").Value
-If B67 = C67 Then
-Range("D67").Value = "OK"
-Else
-Range("D67").Value = "NG"
-End If
-End Function
-
-Function test_xlXErrorBars(ByRef num)
-Range("A68").Clear
-Range("B68").Clear
-Range("C68").Clear
-Range("D68").Clear
-Range("A68").Value = "xlXErrorBars"
-Range("B68").Value = 10
-Range("C68").Value = num
-B68 = Range("B68").Value
-C68 = Range("C68").Value
-If B68 = C68 Then
-Range("D68").Value = "OK"
-Else
-Range("D68").Value = "NG"
-End If
-End Function
-
-Function test_xlYErrorBars(ByRef num)
-Range("A69").Clear
-Range("B69").Clear
-Range("C69").Clear
-Range("D69").Clear
-Range("A69").Value = "xlYErrorBars"
-Range("B69").Value = 11
-Range("C69").Value = num
-B69 = Range("B69").Value
-C69 = Range("C69").Value
-If B69 = C69 Then
-Range("D69").Value = "OK"
-Else
-Range("D69").Value = "NG"
-End If
-End Function
-
-Function test_xlLocationAsNewSheet(ByRef num)
-Range("A70").Clear
-Range("B70").Clear
-Range("C70").Clear
-Range("D70").Clear
-Range("A70").Value = "xlLocationAsNewSheet"
-Range("B70").Value = 1
-Range("C70").Value = num
-B70 = Range("B70").Value
-C70 = Range("C70").Value
-If B70 = C70 Then
-Range("D70").Value = "OK"
-Else
-Range("D70").Value = "NG"
-End If
-End Function
-
-Function test_xlLocationAsObject(ByRef num)
-Range("A71").Clear
-Range("B71").Clear
-Range("C71").Clear
-Range("D71").Clear
-Range("A71").Value = "xlLocationAsObject"
-Range("B71").Value = 2
-Range("C71").Value = num
-B71 = Range("B71").Value
-C71 = Range("C71").Value
-If B71 = C71 Then
-Range("D71").Value = "OK"
-Else
-Range("D71").Value = "NG"
-End If
-End Function
-
-Function test_xlLocationAutomatic(ByRef num)
-Range("A72").Clear
-Range("B72").Clear
-Range("C72").Clear
-Range("D72").Clear
-Range("A72").Value = "xlLocationAutomatic"
-Range("B72").Value = 3
-Range("C72").Value = num
-B72 = Range("B72").Value
-C72 = Range("C72").Value
-If B72 = C72 Then
-Range("D72").Value = "OK"
-Else
-Range("D72").Value = "NG"
-End If
-End Function
-
-Function test_xlAllFaces(ByRef num)
-Range("A73").Clear
-Range("B73").Clear
-Range("C73").Clear
-Range("D73").Clear
-Range("A73").Value = "xlAllFaces"
-Range("B73").Value = 7
-Range("C73").Value = num
-B73 = Range("B73").Value
-C73 = Range("C73").Value
-If B73 = C73 Then
-Range("D73").Value = "OK"
-Else
-Range("D73").Value = "NG"
-End If
-End Function
-
-Function test_xlEnd(ByRef num)
-Range("A74").Clear
-Range("B74").Clear
-Range("C74").Clear
-Range("D74").Clear
-Range("A74").Value = "xlEnd"
-Range("B74").Value = 2
-Range("C74").Value = num
-B74 = Range("B74").Value
-C74 = Range("C74").Value
-If B74 = C74 Then
-Range("D74").Value = "OK"
-Else
-Range("D74").Value = "NG"
-End If
-End Function
-
-Function test_xlEndSides(ByRef num)
-Range("A75").Clear
-Range("B75").Clear
-Range("C75").Clear
-Range("D75").Clear
-Range("A75").Value = "xlEndSides"
-Range("B75").Value = 3
-Range("C75").Value = num
-B75 = Range("B75").Value
-C75 = Range("C75").Value
-If B75 = C75 Then
-Range("D75").Value = "OK"
-Else
-Range("D75").Value = "NG"
-End If
-End Function
-
-Function test_xlFront(ByRef num)
-Range("A76").Clear
-Range("B76").Clear
-Range("C76").Clear
-Range("D76").Clear
-Range("A76").Value = "xlFront"
-Range("B76").Value = 4
-Range("C76").Value = num
-B76 = Range("B76").Value
-C76 = Range("C76").Value
-If B76 = C76 Then
-Range("D76").Value = "OK"
-Else
-Range("D76").Value = "NG"
-End If
-End Function
-
-Function test_xlFrontEnd(ByRef num)
-Range("A77").Clear
-Range("B77").Clear
-Range("C77").Clear
-Range("D77").Clear
-Range("A77").Value = "xlFrontEnd"
-Range("B77").Value = 6
-Range("C77").Value = num
-B77 = Range("B77").Value
-C77 = Range("C77").Value
-If B77 = C77 Then
-Range("D77").Value = "OK"
-Else
-Range("D77").Value = "NG"
-End If
-End Function
-
-Function test_xlFrontSides(ByRef num)
-Range("A78").Clear
-Range("B78").Clear
-Range("C78").Clear
-Range("D78").Clear
-Range("A78").Value = "xlFrontSides"
-Range("B78").Value = 5
-Range("C78").Value = num
-B78 = Range("B78").Value
-C78 = Range("C78").Value
-If B78 = C78 Then
-Range("D78").Value = "OK"
-Else
-Range("D78").Value = "NG"
-End If
-End Function
-
-Function test_xlSlides(ByRef num)
-Range("A79").Clear
-Range("B79").Clear
-Range("C79").Clear
-Range("D79").Clear
-Range("A79").Value = "xlSlides"
-Range("B79").Value = 1
-Range("C79").Value = num
-B79 = Range("B79").Value
-C79 = Range("C79").Value
-If B79 = C79 Then
-Range("D79").Value = "OK"
-Else
-Range("D79").Value = "NG"
-End If
-End Function
-
-Function test_xlStack(ByRef num)
-Range("A80").Clear
-Range("B80").Clear
-Range("C80").Clear
-Range("D80").Clear
-Range("A80").Value = "xlStack"
-Range("B80").Value = 2
-Range("C80").Value = num
-B80 = Range("B80").Value
-C80 = Range("C80").Value
-If B80 = C80 Then
-Range("D80").Value = "OK"
-Else
-Range("D80").Value = "NG"
-End If
-End Function
-
-Function test_xlStackScale(ByRef num)
-Range("A81").Clear
-Range("B81").Clear
-Range("C81").Clear
-Range("D81").Clear
-Range("A81").Value = "xlStackScale"
-Range("B81").Value = 3
-Range("C81").Value = num
-B81 = Range("B81").Value
-C81 = Range("C81").Value
-If B81 = C81 Then
-Range("D81").Value = "OK"
-Else
-Range("D81").Value = "NG"
-End If
-End Function
-
-Function test_xlStretch(ByRef num)
-Range("A82").Clear
-Range("B82").Clear
-Range("C82").Clear
-Range("D82").Clear
-Range("A82").Value = "xlStretch"
-Range("B82").Value = 1
-Range("C82").Value = num
-B82 = Range("B82").Value
-C82 = Range("C82").Value
-If B82 = C82 Then
-Range("D82").Value = "OK"
-Else
-Range("D82").Value = "NG"
-End If
-End Function
-
-Function test_xlSplitByCustomSplit(ByRef num)
-Range("A83").Clear
-Range("B83").Clear
-Range("C83").Clear
-Range("D83").Clear
-Range("A83").Value = "xlSplitByCustomSplit"
-Range("B83").Value = 4
-Range("C83").Value = num
-B83 = Range("B83").Value
-C83 = Range("C83").Value
-If B83 = C83 Then
-Range("D83").Value = "OK"
-Else
-Range("D83").Value = "NG"
-End If
-End Function
-
-Function test_xlSplitByPercentValue(ByRef num)
-Range("A84").Clear
-Range("B84").Clear
-Range("C84").Clear
-Range("D84").Clear
-Range("A84").Value = "xlSplitByPercentValue"
-Range("B84").Value = 3
-Range("C84").Value = num
-B84 = Range("B84").Value
-C84 = Range("C84").Value
-If B84 = C84 Then
-Range("D84").Value = "OK"
-Else
-Range("D84").Value = "NG"
-End If
-End Function
-
-Function test_xlSplitByPercentPosition(ByRef num)
-Range("A85").Clear
-Range("B85").Clear
-Range("C85").Clear
-Range("D85").Clear
-Range("A85").Value = "xlSplitByPercentPosition"
-Range("B85").Value = 1
-Range("C85").Value = num
-B85 = Range("B85").Value
-C85 = Range("C85").Value
-If B85 = C85 Then
-Range("D85").Value = "OK"
-Else
-Range("D85").Value = "NG"
-End If
-End Function
-
-Function test_xlSplitByValue(ByRef num)
-Range("A86").Clear
-Range("B86").Clear
-Range("C86").Clear
-Range("D86").Clear
-Range("A86").Value = "xlSplitByValue"
-Range("B86").Value = 2
-Range("C86").Value = num
-B86 = Range("B86").Value
-C86 = Range("C86").Value
-If B86 = C86 Then
-Range("D86").Value = "OK"
-Else
-Range("D86").Value = "NG"
-End If
-End Function
-
-Function test_xl3DArea(ByRef num)
-Range("A87").Clear
-Range("B87").Clear
-Range("C87").Clear
-Range("D87").Clear
-Range("A87").Value = "xl3DArea"
-Range("B87").Value = -4098
-Range("C87").Value = num
-B87 = Range("B87").Value
-C87 = Range("C87").Value
-If B87 = C87 Then
-Range("D87").Value = "OK"
-Else
-Range("D87").Value = "NG"
-End If
-End Function
-
-Function test_xl3DAreaStacked(ByRef num)
-Range("A88").Clear
-Range("B88").Clear
-Range("C88").Clear
-Range("D88").Clear
-Range("A88").Value = "xl3DAreaStacked"
-Range("B88").Value = 78
-Range("C88").Value = num
-B88 = Range("B88").Value
-C88 = Range("C88").Value
-If B88 = C88 Then
-Range("D88").Value = "OK"
-Else
-Range("D88").Value = "NG"
-End If
-End Function
-
-Function test_xl3DAreaStacked100(ByRef num)
-Range("A89").Clear
-Range("B89").Clear
-Range("C89").Clear
-Range("D89").Clear
-Range("A89").Value = "xl3DAreaStacked100"
-Range("B89").Value = 79
-Range("C89").Value = num
-B89 = Range("B89").Value
-C89 = Range("C89").Value
-If B89 = C89 Then
-Range("D89").Value = "OK"
-Else
-Range("D89").Value = "NG"
-End If
-End Function
-
-Function test_xl3DBarClustered(ByRef num)
-Range("A90").Clear
-Range("B90").Clear
-Range("C90").Clear
-Range("D90").Clear
-Range("A90").Value = "xl3DBarClustered"
-Range("B90").Value = 60
-Range("C90").Value = num
-B90 = Range("B90").Value
-C90 = Range("C90").Value
-If B90 = C90 Then
-Range("D90").Value = "OK"
-Else
-Range("D90").Value = "NG"
-End If
-End Function
-
-Function test_xl3DBarStacked(ByRef num)
-Range("A91").Clear
-Range("B91").Clear
-Range("C91").Clear
-Range("D91").Clear
-Range("A91").Value = "xl3DBarStacked"
-Range("B91").Value = 61
-Range("C91").Value = num
-B91 = Range("B91").Value
-C91 = Range("C91").Value
-If B91 = C91 Then
-Range("D91").Value = "OK"
-Else
-Range("D91").Value = "NG"
-End If
-End Function
-
-Function test_xl3DBarStacked100(ByRef num)
-Range("A92").Clear
-Range("B92").Clear
-Range("C92").Clear
-Range("D92").Clear
-Range("A92").Value = "xl3DBarStacked100"
-Range("B92").Value = 62
-Range("C92").Value = num
-B92 = Range("B92").Value
-C92 = Range("C92").Value
-If B92 = C92 Then
-Range("D92").Value = "OK"
-Else
-Range("D92").Value = "NG"
-End If
-End Function
-
-Function test_xl3DColumn(ByRef num)
-Range("A93").Clear
-Range("B93").Clear
-Range("C93").Clear
-Range("D93").Clear
-Range("A93").Value = "xl3DColumn"
-Range("B93").Value = -4100
-Range("C93").Value = num
-B93 = Range("B93").Value
-C93 = Range("C93").Value
-If B93 = C93 Then
-Range("D93").Value = "OK"
-Else
-Range("D93").Value = "NG"
-End If
-End Function
-
-Function test_xl3DColumnClustered(ByRef num)
-Range("A94").Clear
-Range("B94").Clear
-Range("C94").Clear
-Range("D94").Clear
-Range("A94").Value = "xl3DColumnClustered"
-Range("B94").Value = 54
-Range("C94").Value = num
-B94 = Range("B94").Value
-C94 = Range("C94").Value
-If B94 = C94 Then
-Range("D94").Value = "OK"
-Else
-Range("D94").Value = "NG"
-End If
-End Function
-
-Function test_xl3DColumnStacked(ByRef num)
-Range("A95").Clear
-Range("B95").Clear
-Range("C95").Clear
-Range("D95").Clear
-Range("A95").Value = "xl3DColumnStacked"
-Range("B95").Value = 55
-Range("C95").Value = num
-B95 = Range("B95").Value
-C95 = Range("C95").Value
-If B95 = C95 Then
-Range("D95").Value = "OK"
-Else
-Range("D95").Value = "NG"
-End If
-End Function
-
-Function test_xl3DColumnStacked100(ByRef num)
-Range("A96").Clear
-Range("B96").Clear
-Range("C96").Clear
-Range("D96").Clear
-Range("A96").Value = "xl3DColumnStacked100"
-Range("B96").Value = 56
-Range("C96").Value = num
-B96 = Range("B96").Value
-C96 = Range("C96").Value
-If B96 = C96 Then
-Range("D96").Value = "OK"
-Else
-Range("D96").Value = "NG"
-End If
-End Function
-
-Function test_xl3DLine(ByRef num)
-Range("A97").Clear
-Range("B97").Clear
-Range("C97").Clear
-Range("D97").Clear
-Range("A97").Value = "xl3DLine"
-Range("B97").Value = -4101
-Range("C97").Value = num
-B97 = Range("B97").Value
-C97 = Range("C97").Value
-If B97 = C97 Then
-Range("D97").Value = "OK"
-Else
-Range("D97").Value = "NG"
-End If
-End Function
-
-Function test_xl3DPie(ByRef num)
-Range("A98").Clear
-Range("B98").Clear
-Range("C98").Clear
-Range("D98").Clear
-Range("A98").Value = "xl3DPie"
-Range("B98").Value = -4102
-Range("C98").Value = num
-B98 = Range("B98").Value
-C98 = Range("C98").Value
-If B98 = C98 Then
-Range("D98").Value = "OK"
-Else
-Range("D98").Value = "NG"
-End If
-End Function
-
-Function test_xl3DPieExploded(ByRef num)
-Range("A99").Clear
-Range("B99").Clear
-Range("C99").Clear
-Range("D99").Clear
-Range("A99").Value = "xl3DPieExploded"
-Range("B99").Value = 70
-Range("C99").Value = num
-B99 = Range("B99").Value
-C99 = Range("C99").Value
-If B99 = C99 Then
-Range("D99").Value = "OK"
-Else
-Range("D99").Value = "NG"
-End If
-End Function
-
-Function test_xlArea(ByRef num)
-Range("A100").Clear
-Range("B100").Clear
-Range("C100").Clear
-Range("D100").Clear
-Range("A100").Value = "xlArea"
-Range("B100").Value = 1
-Range("C100").Value = num
-B100 = Range("B100").Value
-C100 = Range("C100").Value
-If B100 = C100 Then
-Range("D100").Value = "OK"
-Else
-Range("D100").Value = "NG"
-End If
-End Function
-
-Function test_xlAreaStacked(ByRef num)
-Range("A101").Clear
-Range("B101").Clear
-Range("C101").Clear
-Range("D101").Clear
-Range("A101").Value = "xlAreaStacked"
-Range("B101").Value = 76
-Range("C101").Value = num
-B101 = Range("B101").Value
-C101 = Range("C101").Value
-If B101 = C101 Then
-Range("D101").Value = "OK"
-Else
-Range("D101").Value = "NG"
-End If
-End Function
-
-Function test_xlAreaStacked100(ByRef num)
-Range("A102").Clear
-Range("B102").Clear
-Range("C102").Clear
-Range("D102").Clear
-Range("A102").Value = "xlAreaStacked100"
-Range("B102").Value = 77
-Range("C102").Value = num
-B102 = Range("B102").Value
-C102 = Range("C102").Value
-If B102 = C102 Then
-Range("D102").Value = "OK"
-Else
-Range("D102").Value = "NG"
-End If
-End Function
-
-Function test_xlBarClustered(ByRef num)
-Range("A103").Clear
-Range("B103").Clear
-Range("C103").Clear
-Range("D103").Clear
-Range("A103").Value = "xlBarClustered"
-Range("B103").Value = 57
-Range("C103").Value = num
-B103 = Range("B103").Value
-C103 = Range("C103").Value
-If B103 = C103 Then
-Range("D103").Value = "OK"
-Else
-Range("D103").Value = "NG"
-End If
-End Function
-
-Function test_xlBarOfPie(ByRef num)
-Range("A104").Clear
-Range("B104").Clear
-Range("C104").Clear
-Range("D104").Clear
-Range("A104").Value = "xlBarOfPie"
-Range("B104").Value = 71
-Range("C104").Value = num
-B104 = Range("B104").Value
-C104 = Range("C104").Value
-If B104 = C104 Then
-Range("D104").Value = "OK"
-Else
-Range("D104").Value = "NG"
-End If
-End Function
-
-Function test_xlBarStacked(ByRef num)
-Range("A105").Clear
-Range("B105").Clear
-Range("C105").Clear
-Range("D105").Clear
-Range("A105").Value = "xlBarStacked"
-Range("B105").Value = 58
-Range("C105").Value = num
-B105 = Range("B105").Value
-C105 = Range("C105").Value
-If B105 = C105 Then
-Range("D105").Value = "OK"
-Else
-Range("D105").Value = "NG"
-End If
-End Function
-
-Function test_xlBarStacked100(ByRef num)
-Range("A106").Clear
-Range("B106").Clear
-Range("C106").Clear
-Range("D106").Clear
-Range("A106").Value = "xlBarStacked100"
-Range("B106").Value = 59
-Range("C106").Value = num
-B106 = Range("B106").Value
-C106 = Range("C106").Value
-If B106 = C106 Then
-Range("D106").Value = "OK"
-Else
-Range("D106").Value = "NG"
-End If
-End Function
-
-Function test_xlBubble(ByRef num)
-Range("A107").Clear
-Range("B107").Clear
-Range("C107").Clear
-Range("D107").Clear
-Range("A107").Value = "xlBubble"
-Range("B107").Value = 15
-Range("C107").Value = num
-B107 = Range("B107").Value
-C107 = Range("C107").Value
-If B107 = C107 Then
-Range("D107").Value = "OK"
-Else
-Range("D107").Value = "NG"
-End If
-End Function
-
-Function test_xlBubble3DEffect(ByRef num)
-Range("A108").Clear
-Range("B108").Clear
-Range("C108").Clear
-Range("D108").Clear
-Range("A108").Value = "xlBubble3DEffect"
-Range("B108").Value = 87
-Range("C108").Value = num
-B108 = Range("B108").Value
-C108 = Range("C108").Value
-If B108 = C108 Then
-Range("D108").Value = "OK"
-Else
-Range("D108").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnClustered(ByRef num)
-Range("A109").Clear
-Range("B109").Clear
-Range("C109").Clear
-Range("D109").Clear
-Range("A109").Value = "xlColumnClustered"
-Range("B109").Value = 51
-Range("C109").Value = num
-B109 = Range("B109").Value
-C109 = Range("C109").Value
-If B109 = C109 Then
-Range("D109").Value = "OK"
-Else
-Range("D109").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnStacked(ByRef num)
-Range("A110").Clear
-Range("B110").Clear
-Range("C110").Clear
-Range("D110").Clear
-Range("A110").Value = "xlColumnStacked"
-Range("B110").Value = 52
-Range("C110").Value = num
-B110 = Range("B110").Value
-C110 = Range("C110").Value
-If B110 = C110 Then
-Range("D110").Value = "OK"
-Else
-Range("D110").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnStacked100(ByRef num)
-Range("A111").Clear
-Range("B111").Clear
-Range("C111").Clear
-Range("D111").Clear
-Range("A111").Value = "xlColumnStacked100"
-Range("B111").Value = 53
-Range("C111").Value = num
-B111 = Range("B111").Value
-C111 = Range("C111").Value
-If B111 = C111 Then
-Range("D111").Value = "OK"
-Else
-Range("D111").Value = "NG"
-End If
-End Function
-
-Function test_xlConeBarClustered(ByRef num)
-Range("A112").Clear
-Range("B112").Clear
-Range("C112").Clear
-Range("D112").Clear
-Range("A112").Value = "xlConeBarClustered"
-Range("B112").Value = 102
-Range("C112").Value = num
-B112 = Range("B112").Value
-C112 = Range("C112").Value
-If B112 = C112 Then
-Range("D112").Value = "OK"
-Else
-Range("D112").Value = "NG"
-End If
-End Function
-
-Function test_xlConeBarStacked(ByRef num)
-Range("A113").Clear
-Range("B113").Clear
-Range("C113").Clear
-Range("D113").Clear
-Range("A113").Value = "xlConeBarStacked"
-Range("B113").Value = 103
-Range("C113").Value = num
-B113 = Range("B113").Value
-C113 = Range("C113").Value
-If B113 = C113 Then
-Range("D113").Value = "OK"
-Else
-Range("D113").Value = "NG"
-End If
-End Function
-
-Function test_xlConeBarStacked100(ByRef num)
-Range("A114").Clear
-Range("B114").Clear
-Range("C114").Clear
-Range("D114").Clear
-Range("A114").Value = "xlConeBarStacked100"
-Range("B114").Value = 104
-Range("C114").Value = num
-B114 = Range("B114").Value
-C114 = Range("C114").Value
-If B114 = C114 Then
-Range("D114").Value = "OK"
-Else
-Range("D114").Value = "NG"
-End If
-End Function
-
-Function test_xlConeCol(ByRef num)
-Range("A115").Clear
-Range("B115").Clear
-Range("C115").Clear
-Range("D115").Clear
-Range("A115").Value = "xlConeCol"
-Range("B115").Value = 105
-Range("C115").Value = num
-B115 = Range("B115").Value
-C115 = Range("C115").Value
-If B115 = C115 Then
-Range("D115").Value = "OK"
-Else
-Range("D115").Value = "NG"
-End If
-End Function
-
-Function test_xlConeColClustered(ByRef num)
-Range("A116").Clear
-Range("B116").Clear
-Range("C116").Clear
-Range("D116").Clear
-Range("A116").Value = "xlConeColClustered"
-Range("B116").Value = 99
-Range("C116").Value = num
-B116 = Range("B116").Value
-C116 = Range("C116").Value
-If B116 = C116 Then
-Range("D116").Value = "OK"
-Else
-Range("D116").Value = "NG"
-End If
-End Function
-
-Function test_xlConeColStacked(ByRef num)
-Range("A117").Clear
-Range("B117").Clear
-Range("C117").Clear
-Range("D117").Clear
-Range("A117").Value = "xlConeColStacked"
-Range("B117").Value = 100
-Range("C117").Value = num
-B117 = Range("B117").Value
-C117 = Range("C117").Value
-If B117 = C117 Then
-Range("D117").Value = "OK"
-Else
-Range("D117").Value = "NG"
-End If
-End Function
-
-Function test_xlConeColStacked100(ByRef num)
-Range("A118").Clear
-Range("B118").Clear
-Range("C118").Clear
-Range("D118").Clear
-Range("A118").Value = "xlConeColStacked100"
-Range("B118").Value = 101
-Range("C118").Value = num
-B118 = Range("B118").Value
-C118 = Range("C118").Value
-If B118 = C118 Then
-Range("D118").Value = "OK"
-Else
-Range("D118").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderBarClustered(ByRef num)
-Range("A119").Clear
-Range("B119").Clear
-Range("C119").Clear
-Range("D119").Clear
-Range("A119").Value = "xlCylinderBarClustered"
-Range("B119").Value = 95
-Range("C119").Value = num
-B119 = Range("B119").Value
-C119 = Range("C119").Value
-If B119 = C119 Then
-Range("D119").Value = "OK"
-Else
-Range("D119").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderBarStacked(ByRef num)
-Range("A120").Clear
-Range("B120").Clear
-Range("C120").Clear
-Range("D120").Clear
-Range("A120").Value = "xlCylinderBarStacked"
-Range("B120").Value = 96
-Range("C120").Value = num
-B120 = Range("B120").Value
-C120 = Range("C120").Value
-If B120 = C120 Then
-Range("D120").Value = "OK"
-Else
-Range("D120").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderBarStacked100(ByRef num)
-Range("A121").Clear
-Range("B121").Clear
-Range("C121").Clear
-Range("D121").Clear
-Range("A121").Value = "xlCylinderBarStacked100"
-Range("B121").Value = 97
-Range("C121").Value = num
-B121 = Range("B121").Value
-C121 = Range("C121").Value
-If B121 = C121 Then
-Range("D121").Value = "OK"
-Else
-Range("D121").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderCol(ByRef num)
-Range("A122").Clear
-Range("B122").Clear
-Range("C122").Clear
-Range("D122").Clear
-Range("A122").Value = "xlCylinderCol"
-Range("B122").Value = 98
-Range("C122").Value = num
-B122 = Range("B122").Value
-C122 = Range("C122").Value
-If B122 = C122 Then
-Range("D122").Value = "OK"
-Else
-Range("D122").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderColClustered(ByRef num)
-Range("A123").Clear
-Range("B123").Clear
-Range("C123").Clear
-Range("D123").Clear
-Range("A123").Value = "xlCylinderColClustered"
-Range("B123").Value = 92
-Range("C123").Value = num
-B123 = Range("B123").Value
-C123 = Range("C123").Value
-If B123 = C123 Then
-Range("D123").Value = "OK"
-Else
-Range("D123").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderColStacked(ByRef num)
-Range("A124").Clear
-Range("B124").Clear
-Range("C124").Clear
-Range("D124").Clear
-Range("A124").Value = "xlCylinderColStacked"
-Range("B124").Value = 93
-Range("C124").Value = num
-B124 = Range("B124").Value
-C124 = Range("C124").Value
-If B124 = C124 Then
-Range("D124").Value = "OK"
-Else
-Range("D124").Value = "NG"
-End If
-End Function
-
-Function test_xlCylinderColStacked100(ByRef num)
-Range("A125").Clear
-Range("B125").Clear
-Range("C125").Clear
-Range("D125").Clear
-Range("A125").Value = "xlCylinderColStacked100"
-Range("B125").Value = 94
-Range("C125").Value = num
-B125 = Range("B125").Value
-C125 = Range("C125").Value
-If B125 = C125 Then
-Range("D125").Value = "OK"
-Else
-Range("D125").Value = "NG"
-End If
-End Function
-
-Function test_xlDoughnut(ByRef num)
-Range("A126").Clear
-Range("B126").Clear
-Range("C126").Clear
-Range("D126").Clear
-Range("A126").Value = "xlDoughnut"
-Range("B126").Value = -4120
-Range("C126").Value = num
-B126 = Range("B126").Value
-C126 = Range("C126").Value
-If B126 = C126 Then
-Range("D126").Value = "OK"
-Else
-Range("D126").Value = "NG"
-End If
-End Function
-
-Function test_xlDoughnutExploded(ByRef num)
-Range("A127").Clear
-Range("B127").Clear
-Range("C127").Clear
-Range("D127").Clear
-Range("A127").Value = "xlDoughnutExploded"
-Range("B127").Value = 80
-Range("C127").Value = num
-B127 = Range("B127").Value
-C127 = Range("C127").Value
-If B127 = C127 Then
-Range("D127").Value = "OK"
-Else
-Range("D127").Value = "NG"
-End If
-End Function
-
-Function test_xlLine(ByRef num)
-Range("A128").Clear
-Range("B128").Clear
-Range("C128").Clear
-Range("D128").Clear
-Range("A128").Value = "xlLine"
-Range("B128").Value = 4
-Range("C128").Value = num
-B128 = Range("B128").Value
-C128 = Range("C128").Value
-If B128 = C128 Then
-Range("D128").Value = "OK"
-Else
-Range("D128").Value = "NG"
-End If
-End Function
-
-Function test_xlLineMarkers(ByRef num)
-Range("A129").Clear
-Range("B129").Clear
-Range("C129").Clear
-Range("D129").Clear
-Range("A129").Value = "xlLineMarkers"
-Range("B129").Value = 65
-Range("C129").Value = num
-B129 = Range("B129").Value
-C129 = Range("C129").Value
-If B129 = C129 Then
-Range("D129").Value = "OK"
-Else
-Range("D129").Value = "NG"
-End If
-End Function
-
-Function test_xlLineMarkersStacked(ByRef num)
-Range("A130").Clear
-Range("B130").Clear
-Range("C130").Clear
-Range("D130").Clear
-Range("A130").Value = "xlLineMarkersStacked"
-Range("B130").Value = 66
-Range("C130").Value = num
-B130 = Range("B130").Value
-C130 = Range("C130").Value
-If B130 = C130 Then
-Range("D130").Value = "OK"
-Else
-Range("D130").Value = "NG"
-End If
-End Function
-
-Function test_xlLineMarkersStacked100(ByRef num)
-Range("A131").Clear
-Range("B131").Clear
-Range("C131").Clear
-Range("D131").Clear
-Range("A131").Value = "xlLineMarkersStacked100"
-Range("B131").Value = 67
-Range("C131").Value = num
-B131 = Range("B131").Value
-C131 = Range("C131").Value
-If B131 = C131 Then
-Range("D131").Value = "OK"
-Else
-Range("D131").Value = "NG"
-End If
-End Function
-
-Function test_xlLineStacked(ByRef num)
-Range("A132").Clear
-Range("B132").Clear
-Range("C132").Clear
-Range("D132").Clear
-Range("A132").Value = "xlLineStacked"
-Range("B132").Value = 63
-Range("C132").Value = num
-B132 = Range("B132").Value
-C132 = Range("C132").Value
-If B132 = C132 Then
-Range("D132").Value = "OK"
-Else
-Range("D132").Value = "NG"
-End If
-End Function
-
-Function test_xlLineStacked100(ByRef num)
-Range("A133").Clear
-Range("B133").Clear
-Range("C133").Clear
-Range("D133").Clear
-Range("A133").Value = "xlLineStacked100"
-Range("B133").Value = 64
-Range("C133").Value = num
-B133 = Range("B133").Value
-C133 = Range("C133").Value
-If B133 = C133 Then
-Range("D133").Value = "OK"
-Else
-Range("D133").Value = "NG"
-End If
-End Function
-
-Function test_xlPie(ByRef num)
-Range("A134").Clear
-Range("B134").Clear
-Range("C134").Clear
-Range("D134").Clear
-Range("A134").Value = "xlPie"
-Range("B134").Value = 5
-Range("C134").Value = num
-B134 = Range("B134").Value
-C134 = Range("C134").Value
-If B134 = C134 Then
-Range("D134").Value = "OK"
-Else
-Range("D134").Value = "NG"
-End If
-End Function
-
-Function test_xlPieExploded(ByRef num)
-Range("A135").Clear
-Range("B135").Clear
-Range("C135").Clear
-Range("D135").Clear
-Range("A135").Value = "xlPieExploded"
-Range("B135").Value = 69
-Range("C135").Value = num
-B135 = Range("B135").Value
-C135 = Range("C135").Value
-If B135 = C135 Then
-Range("D135").Value = "OK"
-Else
-Range("D135").Value = "NG"
-End If
-End Function
-
-Function test_xlPieOfPie(ByRef num)
-Range("A136").Clear
-Range("B136").Clear
-Range("C136").Clear
-Range("D136").Clear
-Range("A136").Value = "xlPieOfPie"
-Range("B136").Value = 68
-Range("C136").Value = num
-B136 = Range("B136").Value
-C136 = Range("C136").Value
-If B136 = C136 Then
-Range("D136").Value = "OK"
-Else
-Range("D136").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidBarClustered(ByRef num)
-Range("A137").Clear
-Range("B137").Clear
-Range("C137").Clear
-Range("D137").Clear
-Range("A137").Value = "xlPyramidBarClustered"
-Range("B137").Value = 109
-Range("C137").Value = num
-B137 = Range("B137").Value
-C137 = Range("C137").Value
-If B137 = C137 Then
-Range("D137").Value = "OK"
-Else
-Range("D137").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidBarStacked(ByRef num)
-Range("A138").Clear
-Range("B138").Clear
-Range("C138").Clear
-Range("D138").Clear
-Range("A138").Value = "xlPyramidBarStacked"
-Range("B138").Value = 110
-Range("C138").Value = num
-B138 = Range("B138").Value
-C138 = Range("C138").Value
-If B138 = C138 Then
-Range("D138").Value = "OK"
-Else
-Range("D138").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidBarStacked100(ByRef num)
-Range("A139").Clear
-Range("B139").Clear
-Range("C139").Clear
-Range("D139").Clear
-Range("A139").Value = "xlPyramidBarStacked100"
-Range("B139").Value = 111
-Range("C139").Value = num
-B139 = Range("B139").Value
-C139 = Range("C139").Value
-If B139 = C139 Then
-Range("D139").Value = "OK"
-Else
-Range("D139").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidCol(ByRef num)
-Range("A140").Clear
-Range("B140").Clear
-Range("C140").Clear
-Range("D140").Clear
-Range("A140").Value = "xlPyramidCol"
-Range("B140").Value = 112
-Range("C140").Value = num
-B140 = Range("B140").Value
-C140 = Range("C140").Value
-If B140 = C140 Then
-Range("D140").Value = "OK"
-Else
-Range("D140").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidColClustered(ByRef num)
-Range("A141").Clear
-Range("B141").Clear
-Range("C141").Clear
-Range("D141").Clear
-Range("A141").Value = "xlPyramidColClustered"
-Range("B141").Value = 106
-Range("C141").Value = num
-B141 = Range("B141").Value
-C141 = Range("C141").Value
-If B141 = C141 Then
-Range("D141").Value = "OK"
-Else
-Range("D141").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidColStacked(ByRef num)
-Range("A142").Clear
-Range("B142").Clear
-Range("C142").Clear
-Range("D142").Clear
-Range("A142").Value = "xlPyramidColStacked"
-Range("B142").Value = 107
-Range("C142").Value = num
-B142 = Range("B142").Value
-C142 = Range("C142").Value
-If B142 = C142 Then
-Range("D142").Value = "OK"
-Else
-Range("D142").Value = "NG"
-End If
-End Function
-
-Function test_xlPyramidColStacked100(ByRef num)
-Range("A143").Clear
-Range("B143").Clear
-Range("C143").Clear
-Range("D143").Clear
-Range("A143").Value = "xlPyramidColStacked100"
-Range("B143").Value = 108
-Range("C143").Value = num
-B143 = Range("B143").Value
-C143 = Range("C143").Value
-If B143 = C143 Then
-Range("D143").Value = "OK"
-Else
-Range("D143").Value = "NG"
-End If
-End Function
-
-Function test_xlRader(ByRef num)
-Range("A144").Clear
-Range("B144").Clear
-Range("C144").Clear
-Range("D144").Clear
-Range("A144").Value = "xlRader"
-Range("B144").Value = -4151
-Range("C144").Value = num
-B144 = Range("B144").Value
-C144 = Range("C144").Value
-If B144 = C144 Then
-Range("D144").Value = "OK"
-Else
-Range("D144").Value = "NG"
-End If
-End Function
-
-Function test_xlRaderFilled(ByRef num)
-Range("A145").Clear
-Range("B145").Clear
-Range("C145").Clear
-Range("D145").Clear
-Range("A145").Value = "xlRaderFilled"
-Range("B145").Value = 82
-Range("C145").Value = num
-B145 = Range("B145").Value
-C145 = Range("C145").Value
-If B145 = C145 Then
-Range("D145").Value = "OK"
-Else
-Range("D145").Value = "NG"
-End If
-End Function
-
-Function test_xlRaderMarkers(ByRef num)
-Range("A146").Clear
-Range("B146").Clear
-Range("C146").Clear
-Range("D146").Clear
-Range("A146").Value = "xlRaderMarkers"
-Range("B146").Value = 81
-Range("C146").Value = num
-B146 = Range("B146").Value
-C146 = Range("C146").Value
-If B146 = C146 Then
-Range("D146").Value = "OK"
-Else
-Range("D146").Value = "NG"
-End If
-End Function
-
-Function test_xlStockHLC(ByRef num)
-Range("A147").Clear
-Range("B147").Clear
-Range("C147").Clear
-Range("D147").Clear
-Range("A147").Value = "xlStockHLC"
-Range("B147").Value = 88
-Range("C147").Value = num
-B147 = Range("B147").Value
-C147 = Range("C147").Value
-If B147 = C147 Then
-Range("D147").Value = "OK"
-Else
-Range("D147").Value = "NG"
-End If
-End Function
-
-Function test_xlStockOHLC(ByRef num)
-Range("A148").Clear
-Range("B148").Clear
-Range("C148").Clear
-Range("D148").Clear
-Range("A148").Value = "xlStockOHLC"
-Range("B148").Value = 89
-Range("C148").Value = num
-B148 = Range("B148").Value
-C148 = Range("C148").Value
-If B148 = C148 Then
-Range("D148").Value = "OK"
-Else
-Range("D148").Value = "NG"
-End If
-End Function
-
-Function test_xlStockVHLC(ByRef num)
-Range("A149").Clear
-Range("B149").Clear
-Range("C149").Clear
-Range("D149").Clear
-Range("A149").Value = "xlStockVHLC"
-Range("B149").Value = 90
-Range("C149").Value = num
-B149 = Range("B149").Value
-C149 = Range("C149").Value
-If B149 = C149 Then
-Range("D149").Value = "OK"
-Else
-Range("D149").Value = "NG"
-End If
-End Function
-
-Function test_xlStockVOHLC(ByRef num)
-Range("A150").Clear
-Range("B150").Clear
-Range("C150").Clear
-Range("D150").Clear
-Range("A150").Value = "xlStockVOHLC"
-Range("B150").Value = 91
-Range("C150").Value = num
-B150 = Range("B150").Value
-C150 = Range("C150").Value
-If B150 = C150 Then
-Range("D150").Value = "OK"
-Else
-Range("D150").Value = "NG"
-End If
-End Function
-
-Function test_xlSurface(ByRef num)
-Range("A151").Clear
-Range("B151").Clear
-Range("C151").Clear
-Range("D151").Clear
-Range("A151").Value = "xlSurface"
-Range("B151").Value = 83
-Range("C151").Value = num
-B151 = Range("B151").Value
-C151 = Range("C151").Value
-If B151 = C151 Then
-Range("D151").Value = "OK"
-Else
-Range("D151").Value = "NG"
-End If
-End Function
-
-Function test_xlSurfaceTopView(ByRef num)
-Range("A152").Clear
-Range("B152").Clear
-Range("C152").Clear
-Range("D152").Clear
-Range("A152").Value = "xlSurfaceTopView"
-Range("B152").Value = 85
-Range("C152").Value = num
-B152 = Range("B152").Value
-C152 = Range("C152").Value
-If B152 = C152 Then
-Range("D152").Value = "OK"
-Else
-Range("D152").Value = "NG"
-End If
-End Function
-
-Function test_xlSurfaceTopViewWireframe(ByRef num)
-Range("A153").Clear
-Range("B153").Clear
-Range("C153").Clear
-Range("D153").Clear
-Range("A153").Value = "xlSurfaceTopViewWireframe"
-Range("B153").Value = 86
-Range("C153").Value = num
-B153 = Range("B153").Value
-C153 = Range("C153").Value
-If B153 = C153 Then
-Range("D153").Value = "OK"
-Else
-Range("D153").Value = "NG"
-End If
-End Function
-
-Function test_xlSurfaceWireframe(ByRef num)
-Range("A154").Clear
-Range("B154").Clear
-Range("C154").Clear
-Range("D154").Clear
-Range("A154").Value = "xlSurfaceWireframe"
-Range("B154").Value = 84
-Range("C154").Value = num
-B154 = Range("B154").Value
-C154 = Range("C154").Value
-If B154 = C154 Then
-Range("D154").Value = "OK"
-Else
-Range("D154").Value = "NG"
-End If
-End Function
-
-Function test_xlXYScatter(ByRef num)
-Range("A155").Clear
-Range("B155").Clear
-Range("C155").Clear
-Range("D155").Clear
-Range("A155").Value = "xlXYScatter"
-Range("B155").Value = -4169
-Range("C155").Value = num
-B155 = Range("B155").Value
-C155 = Range("C155").Value
-If B155 = C155 Then
-Range("D155").Value = "OK"
-Else
-Range("D155").Value = "NG"
-End If
-End Function
-
-Function test_xlXYScatterLines(ByRef num)
-Range("A156").Clear
-Range("B156").Clear
-Range("C156").Clear
-Range("D156").Clear
-Range("A156").Value = "xlXYScatterLines"
-Range("B156").Value = 74
-Range("C156").Value = num
-B156 = Range("B156").Value
-C156 = Range("C156").Value
-If B156 = C156 Then
-Range("D156").Value = "OK"
-Else
-Range("D156").Value = "NG"
-End If
-End Function
-
-Function test_xlXYScatterLinesNoMarkers(ByRef num)
-Range("A157").Clear
-Range("B157").Clear
-Range("C157").Clear
-Range("D157").Clear
-Range("A157").Value = "xlXYScatterLinesNoMarkers"
-Range("B157").Value = 75
-Range("C157").Value = num
-B157 = Range("B157").Value
-C157 = Range("C157").Value
-If B157 = C157 Then
-Range("D157").Value = "OK"
-Else
-Range("D157").Value = "NG"
-End If
-End Function
-
-Function test_xlXYScatterSmooth(ByRef num)
-Range("A158").Clear
-Range("B158").Clear
-Range("C158").Clear
-Range("D158").Clear
-Range("A158").Value = "xlXYScatterSmooth"
-Range("B158").Value = 72
-Range("C158").Value = num
-B158 = Range("B158").Value
-C158 = Range("C158").Value
-If B158 = C158 Then
-Range("D158").Value = "OK"
-Else
-Range("D158").Value = "NG"
-End If
-End Function
-
-Function test_xlXYScatterSmoothNoMarkers(ByRef num)
-Range("A159").Clear
-Range("B159").Clear
-Range("C159").Clear
-Range("D159").Clear
-Range("A159").Value = "xlXYScatterSmoothNoMarkers"
-Range("B159").Value = 73
-Range("C159").Value = num
-B159 = Range("B159").Value
-C159 = Range("C159").Value
-If B159 = C159 Then
-Range("D159").Value = "OK"
-Else
-Range("D159").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBIFF(ByRef num)
-Range("A160").Clear
-Range("B160").Clear
-Range("C160").Clear
-Range("D160").Clear
-Range("A160").Value = "xlClipboardFormatBIFF"
-Range("B160").Value = 8
-Range("C160").Value = num
-B160 = Range("B160").Value
-C160 = Range("C160").Value
-If B160 = C160 Then
-Range("D160").Value = "OK"
-Else
-Range("D160").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBIFF2(ByRef num)
-Range("A161").Clear
-Range("B161").Clear
-Range("C161").Clear
-Range("D161").Clear
-Range("A161").Value = "xlClipboardFormatBIFF2"
-Range("B161").Value = 18
-Range("C161").Value = num
-B161 = Range("B161").Value
-C161 = Range("C161").Value
-If B161 = C161 Then
-Range("D161").Value = "OK"
-Else
-Range("D161").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBIFF3(ByRef num)
-Range("A162").Clear
-Range("B162").Clear
-Range("C162").Clear
-Range("D162").Clear
-Range("A162").Value = "xlClipboardFormatBIFF3"
-Range("B162").Value = 20
-Range("C162").Value = num
-B162 = Range("B162").Value
-C162 = Range("C162").Value
-If B162 = C162 Then
-Range("D162").Value = "OK"
-Else
-Range("D162").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBIFF4(ByRef num)
-Range("A163").Clear
-Range("B163").Clear
-Range("C163").Clear
-Range("D163").Clear
-Range("A163").Value = "xlClipboardFormatBIFF4"
-Range("B163").Value = 30
-Range("C163").Value = num
-B163 = Range("B163").Value
-C163 = Range("C163").Value
-If B163 = C163 Then
-Range("D163").Value = "OK"
-Else
-Range("D163").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBinary(ByRef num)
-Range("A164").Clear
-Range("B164").Clear
-Range("C164").Clear
-Range("D164").Clear
-Range("A164").Value = "xlClipboardFormatBinary"
-Range("B164").Value = 15
-Range("C164").Value = num
-B164 = Range("B164").Value
-C164 = Range("C164").Value
-If B164 = C164 Then
-Range("D164").Value = "OK"
-Else
-Range("D164").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatBitmap(ByRef num)
-Range("A165").Clear
-Range("B165").Clear
-Range("C165").Clear
-Range("D165").Clear
-Range("A165").Value = "xlClipboardFormatBitmap"
-Range("B165").Value = 9
-Range("C165").Value = num
-B165 = Range("B165").Value
-C165 = Range("C165").Value
-If B165 = C165 Then
-Range("D165").Value = "OK"
-Else
-Range("D165").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatCGM(ByRef num)
-Range("A166").Clear
-Range("B166").Clear
-Range("C166").Clear
-Range("D166").Clear
-Range("A166").Value = "xlClipboardFormatCGM"
-Range("B166").Value = 13
-Range("C166").Value = num
-B166 = Range("B166").Value
-C166 = Range("C166").Value
-If B166 = C166 Then
-Range("D166").Value = "OK"
-Else
-Range("D166").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatCSV(ByRef num)
-Range("A167").Clear
-Range("B167").Clear
-Range("C167").Clear
-Range("D167").Clear
-Range("A167").Value = "xlClipboardFormatCSV"
-Range("B167").Value = 5
-Range("C167").Value = num
-B167 = Range("B167").Value
-C167 = Range("C167").Value
-If B167 = C167 Then
-Range("D167").Value = "OK"
-Else
-Range("D167").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatDIF(ByRef num)
-Range("A168").Clear
-Range("B168").Clear
-Range("C168").Clear
-Range("D168").Clear
-Range("A168").Value = "xlClipboardFormatDIF"
-Range("B168").Value = 4
-Range("C168").Value = num
-B168 = Range("B168").Value
-C168 = Range("C168").Value
-If B168 = C168 Then
-Range("D168").Value = "OK"
-Else
-Range("D168").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatDspText(ByRef num)
-Range("A169").Clear
-Range("B169").Clear
-Range("C169").Clear
-Range("D169").Clear
-Range("A169").Value = "xlClipboardFormatDspText"
-Range("B169").Value = 12
-Range("C169").Value = num
-B169 = Range("B169").Value
-C169 = Range("C169").Value
-If B169 = C169 Then
-Range("D169").Value = "OK"
-Else
-Range("D169").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatEmbeddedObject(ByRef num)
-Range("A170").Clear
-Range("B170").Clear
-Range("C170").Clear
-Range("D170").Clear
-Range("A170").Value = "xlClipboardFormatEmbeddedObject"
-Range("B170").Value = 21
-Range("C170").Value = num
-B170 = Range("B170").Value
-C170 = Range("C170").Value
-If B170 = C170 Then
-Range("D170").Value = "OK"
-Else
-Range("D170").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatEmbedSource(ByRef num)
-Range("A171").Clear
-Range("B171").Clear
-Range("C171").Clear
-Range("D171").Clear
-Range("A171").Value = "xlClipboardFormatEmbedSource"
-Range("B171").Value = 22
-Range("C171").Value = num
-B171 = Range("B171").Value
-C171 = Range("C171").Value
-If B171 = C171 Then
-Range("D171").Value = "OK"
-Else
-Range("D171").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatLink(ByRef num)
-Range("A172").Clear
-Range("B172").Clear
-Range("C172").Clear
-Range("D172").Clear
-Range("A172").Value = "xlClipboardFormatLink"
-Range("B172").Value = 11
-Range("C172").Value = num
-B172 = Range("B172").Value
-C172 = Range("C172").Value
-If B172 = C172 Then
-Range("D172").Value = "OK"
-Else
-Range("D172").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatLinkSource(ByRef num)
-Range("A173").Clear
-Range("B173").Clear
-Range("C173").Clear
-Range("D173").Clear
-Range("A173").Value = "xlClipboardFormatLinkSource"
-Range("B173").Value = 23
-Range("C173").Value = num
-B173 = Range("B173").Value
-C173 = Range("C173").Value
-If B173 = C173 Then
-Range("D173").Value = "OK"
-Else
-Range("D173").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatLinkSourceDesc(ByRef num)
-Range("A174").Clear
-Range("B174").Clear
-Range("C174").Clear
-Range("D174").Clear
-Range("A174").Value = "xlClipboardFormatLinkSourceDesc"
-Range("B174").Value = 32
-Range("C174").Value = num
-B174 = Range("B174").Value
-C174 = Range("C174").Value
-If B174 = C174 Then
-Range("D174").Value = "OK"
-Else
-Range("D174").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatMovie(ByRef num)
-Range("A175").Clear
-Range("B175").Clear
-Range("C175").Clear
-Range("D175").Clear
-Range("A175").Value = "xlClipboardFormatMovie"
-Range("B175").Value = 24
-Range("C175").Value = num
-B175 = Range("B175").Value
-C175 = Range("C175").Value
-If B175 = C175 Then
-Range("D175").Value = "OK"
-Else
-Range("D175").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatNative(ByRef num)
-Range("A176").Clear
-Range("B176").Clear
-Range("C176").Clear
-Range("D176").Clear
-Range("A176").Value = "xlClipboardFormatNative"
-Range("B176").Value = 14
-Range("C176").Value = num
-B176 = Range("B176").Value
-C176 = Range("C176").Value
-If B176 = C176 Then
-Range("D176").Value = "OK"
-Else
-Range("D176").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatObjectDesc(ByRef num)
-Range("A177").Clear
-Range("B177").Clear
-Range("C177").Clear
-Range("D177").Clear
-Range("A177").Value = "xlClipboardFormatObjectDesc"
-Range("B177").Value = 31
-Range("C177").Value = num
-B177 = Range("B177").Value
-C177 = Range("C177").Value
-If B177 = C177 Then
-Range("D177").Value = "OK"
-Else
-Range("D177").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatObjectLink(ByRef num)
-Range("A178").Clear
-Range("B178").Clear
-Range("C178").Clear
-Range("D178").Clear
-Range("A178").Value = "xlClipboardFormatObjectLink"
-Range("B178").Value = 19
-Range("C178").Value = num
-B178 = Range("B178").Value
-C178 = Range("C178").Value
-If B178 = C178 Then
-Range("D178").Value = "OK"
-Else
-Range("D178").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatOwnerLink(ByRef num)
-Range("A179").Clear
-Range("B179").Clear
-Range("C179").Clear
-Range("D179").Clear
-Range("A179").Value = "xlClipboardFormatOwnerLink"
-Range("B179").Value = 17
-Range("C179").Value = num
-B179 = Range("B179").Value
-C179 = Range("C179").Value
-If B179 = C179 Then
-Range("D179").Value = "OK"
-Else
-Range("D179").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatPICT(ByRef num)
-Range("A180").Clear
-Range("B180").Clear
-Range("C180").Clear
-Range("D180").Clear
-Range("A180").Value = "xlClipboardFormatPICT"
-Range("B180").Value = 2
-Range("C180").Value = num
-B180 = Range("B180").Value
-C180 = Range("C180").Value
-If B180 = C180 Then
-Range("D180").Value = "OK"
-Else
-Range("D180").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatPrintPICT(ByRef num)
-Range("A181").Clear
-Range("B181").Clear
-Range("C181").Clear
-Range("D181").Clear
-Range("A181").Value = "xlClipboardFormatPrintPICT"
-Range("B181").Value = 3
-Range("C181").Value = num
-B181 = Range("B181").Value
-C181 = Range("C181").Value
-If B181 = C181 Then
-Range("D181").Value = "OK"
-Else
-Range("D181").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatRTF(ByRef num)
-Range("A182").Clear
-Range("B182").Clear
-Range("C182").Clear
-Range("D182").Clear
-Range("A182").Value = "xlClipboardFormatRTF"
-Range("B182").Value = 7
-Range("C182").Value = num
-B182 = Range("B182").Value
-C182 = Range("C182").Value
-If B182 = C182 Then
-Range("D182").Value = "OK"
-Else
-Range("D182").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatScreenPICT(ByRef num)
-Range("A183").Clear
-Range("B183").Clear
-Range("C183").Clear
-Range("D183").Clear
-Range("A183").Value = "xlClipboardFormatScreenPICT"
-Range("B183").Value = 29
-Range("C183").Value = num
-B183 = Range("B183").Value
-C183 = Range("C183").Value
-If B183 = C183 Then
-Range("D183").Value = "OK"
-Else
-Range("D183").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatStandardFont(ByRef num)
-Range("A184").Clear
-Range("B184").Clear
-Range("C184").Clear
-Range("D184").Clear
-Range("A184").Value = "xlClipboardFormatStandardFont"
-Range("B184").Value = 28
-Range("C184").Value = num
-B184 = Range("B184").Value
-C184 = Range("C184").Value
-If B184 = C184 Then
-Range("D184").Value = "OK"
-Else
-Range("D184").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatStandardScale(ByRef num)
-Range("A185").Clear
-Range("B185").Clear
-Range("C185").Clear
-Range("D185").Clear
-Range("A185").Value = "xlClipboardFormatStandardScale"
-Range("B185").Value = 27
-Range("C185").Value = num
-B185 = Range("B185").Value
-C185 = Range("C185").Value
-If B185 = C185 Then
-Range("D185").Value = "OK"
-Else
-Range("D185").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatSYLK(ByRef num)
-Range("A186").Clear
-Range("B186").Clear
-Range("C186").Clear
-Range("D186").Clear
-Range("A186").Value = "xlClipboardFormatSYLK"
-Range("B186").Value = 6
-Range("C186").Value = num
-B186 = Range("B186").Value
-C186 = Range("C186").Value
-If B186 = C186 Then
-Range("D186").Value = "OK"
-Else
-Range("D186").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatTable(ByRef num)
-Range("A187").Clear
-Range("B187").Clear
-Range("C187").Clear
-Range("D187").Clear
-Range("A187").Value = "xlClipboardFormatTable"
-Range("B187").Value = 16
-Range("C187").Value = num
-B187 = Range("B187").Value
-C187 = Range("C187").Value
-If B187 = C187 Then
-Range("D187").Value = "OK"
-Else
-Range("D187").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatText(ByRef num)
-Range("A188").Clear
-Range("B188").Clear
-Range("C188").Clear
-Range("D188").Clear
-Range("A188").Value = "xlClipboardFormatText"
-Range("B188").Value = 0
-Range("C188").Value = num
-B188 = Range("B188").Value
-C188 = Range("C188").Value
-If B188 = C188 Then
-Range("D188").Value = "OK"
-Else
-Range("D188").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatToolFace(ByRef num)
-Range("A189").Clear
-Range("B189").Clear
-Range("C189").Clear
-Range("D189").Clear
-Range("A189").Value = "xlClipboardFormatToolFace"
-Range("B189").Value = 25
-Range("C189").Value = num
-B189 = Range("B189").Value
-C189 = Range("C189").Value
-If B189 = C189 Then
-Range("D189").Value = "OK"
-Else
-Range("D189").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatToolFacePICT(ByRef num)
-Range("A190").Clear
-Range("B190").Clear
-Range("C190").Clear
-Range("D190").Clear
-Range("A190").Value = "xlClipboardFormatToolFacePICT"
-Range("B190").Value = 26
-Range("C190").Value = num
-B190 = Range("B190").Value
-C190 = Range("C190").Value
-If B190 = C190 Then
-Range("D190").Value = "OK"
-Else
-Range("D190").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatToolVALU(ByRef num)
-Range("A191").Clear
-Range("B191").Clear
-Range("C191").Clear
-Range("D191").Clear
-Range("A191").Value = "xlClipboardFormatToolVALU"
-Range("B191").Value = 1
-Range("C191").Value = num
-B191 = Range("B191").Value
-C191 = Range("C191").Value
-If B191 = C191 Then
-Range("D191").Value = "OK"
-Else
-Range("D191").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboardFormatToolWK1(ByRef num)
-Range("A192").Clear
-Range("B192").Clear
-Range("C192").Clear
-Range("D192").Clear
-Range("A192").Value = "xlClipboardFormatToolWK1"
-Range("B192").Value = 10
-Range("C192").Value = num
-B192 = Range("B192").Value
-C192 = Range("C192").Value
-If B192 = C192 Then
-Range("D192").Value = "OK"
-Else
-Range("D192").Value = "NG"
-End If
-End Function
-
-Function test_xlCmdCube(ByRef num)
-Range("A193").Clear
-Range("B193").Clear
-Range("C193").Clear
-Range("D193").Clear
-Range("A193").Value = "xlCmdCube"
-Range("B193").Value = 1
-Range("C193").Value = num
-B193 = Range("B193").Value
-C193 = Range("C193").Value
-If B193 = C193 Then
-Range("D193").Value = "OK"
-Else
-Range("D193").Value = "NG"
-End If
-End Function
-
-Function test_xlCmdDefault(ByRef num)
-Range("A194").Clear
-Range("B194").Clear
-Range("C194").Clear
-Range("D194").Clear
-Range("A194").Value = "xlCmdDefault"
-Range("B194").Value = 4
-Range("C194").Value = num
-B194 = Range("B194").Value
-C194 = Range("C194").Value
-If B194 = C194 Then
-Range("D194").Value = "OK"
-Else
-Range("D194").Value = "NG"
-End If
-End Function
-
-Function test_xlCmdList(ByRef num)
-Range("A195").Clear
-Range("B195").Clear
-Range("C195").Clear
-Range("D195").Clear
-Range("A195").Value = "xlCmdList"
-Range("B195").Value = 5
-Range("C195").Value = num
-B195 = Range("B195").Value
-C195 = Range("C195").Value
-If B195 = C195 Then
-Range("D195").Value = "OK"
-Else
-Range("D195").Value = "NG"
-End If
-End Function
-
-Function test_xlCmdSql(ByRef num)
-Range("A196").Clear
-Range("B196").Clear
-Range("C196").Clear
-Range("D196").Clear
-Range("A196").Value = "xlCmdSql"
-Range("B196").Value = 2
-Range("C196").Value = num
-B196 = Range("B196").Value
-C196 = Range("C196").Value
-If B196 = C196 Then
-Range("D196").Value = "OK"
-Else
-Range("D196").Value = "NG"
-End If
-End Function
-
-Function test_xlCmdTable(ByRef num)
-Range("A197").Clear
-Range("B197").Clear
-Range("C197").Clear
-Range("D197").Clear
-Range("A197").Value = "xlCmdTable"
-Range("B197").Value = 3
-Range("C197").Value = num
-B197 = Range("B197").Value
-C197 = Range("C197").Value
-If B197 = C197 Then
-Range("D197").Value = "OK"
-Else
-Range("D197").Value = "NG"
-End If
-End Function
-
-Function test_xlColorIndexAutomatic(ByRef num)
-Range("A198").Clear
-Range("B198").Clear
-Range("C198").Clear
-Range("D198").Clear
-Range("A198").Value = "xlColorIndexAutomatic"
-Range("B198").Value = -4105
-Range("C198").Value = num
-B198 = Range("B198").Value
-C198 = Range("C198").Value
-If B198 = C198 Then
-Range("D198").Value = "OK"
-Else
-Range("D198").Value = "NG"
-End If
-End Function
-
-Function test_xlColorIndexNone(ByRef num)
-Range("A199").Clear
-Range("B199").Clear
-Range("C199").Clear
-Range("D199").Clear
-Range("A199").Value = "xlColorIndexNone"
-Range("B199").Value = -4142
-Range("C199").Value = num
-B199 = Range("B199").Value
-C199 = Range("C199").Value
-If B199 = C199 Then
-Range("D199").Value = "OK"
-Else
-Range("D199").Value = "NG"
-End If
-End Function
-
-Function test_xlDMYFormat(ByRef num)
-Range("A200").Clear
-Range("B200").Clear
-Range("C200").Clear
-Range("D200").Clear
-Range("A200").Value = "xlDMYFormat"
-Range("B200").Value = 4
-Range("C200").Value = num
-B200 = Range("B200").Value
-C200 = Range("C200").Value
-If B200 = C200 Then
-Range("D200").Value = "OK"
-Else
-Range("D200").Value = "NG"
-End If
-End Function
-
-Function test_xlDYMFormat(ByRef num)
-Range("A201").Clear
-Range("B201").Clear
-Range("C201").Clear
-Range("D201").Clear
-Range("A201").Value = "xlDYMFormat"
-Range("B201").Value = 7
-Range("C201").Value = num
-B201 = Range("B201").Value
-C201 = Range("C201").Value
-If B201 = C201 Then
-Range("D201").Value = "OK"
-Else
-Range("D201").Value = "NG"
-End If
-End Function
-
-Function test_xlEMDFormat(ByRef num)
-Range("A202").Clear
-Range("B202").Clear
-Range("C202").Clear
-Range("D202").Clear
-Range("A202").Value = "xlEMDFormat"
-Range("B202").Value = 10
-Range("C202").Value = num
-B202 = Range("B202").Value
-C202 = Range("C202").Value
-If B202 = C202 Then
-Range("D202").Value = "OK"
-Else
-Range("D202").Value = "NG"
-End If
-End Function
-
-Function test_xlGeneralFormat(ByRef num)
-Range("A203").Clear
-Range("B203").Clear
-Range("C203").Clear
-Range("D203").Clear
-Range("A203").Value = "xlGeneralFormat"
-Range("B203").Value = 1
-Range("C203").Value = num
-B203 = Range("B203").Value
-C203 = Range("C203").Value
-If B203 = C203 Then
-Range("D203").Value = "OK"
-Else
-Range("D203").Value = "NG"
-End If
-End Function
-
-Function test_xlMDYFormat(ByRef num)
-Range("A204").Clear
-Range("B204").Clear
-Range("C204").Clear
-Range("D204").Clear
-Range("A204").Value = "xlMDYFormat"
-Range("B204").Value = 3
-Range("C204").Value = num
-B204 = Range("B204").Value
-C204 = Range("C204").Value
-If B204 = C204 Then
-Range("D204").Value = "OK"
-Else
-Range("D204").Value = "NG"
-End If
-End Function
-
-Function test_xlMYDFormat(ByRef num)
-Range("A205").Clear
-Range("B205").Clear
-Range("C205").Clear
-Range("D205").Clear
-Range("A205").Value = "xlMYDFormat"
-Range("B205").Value = 6
-Range("C205").Value = num
-B205 = Range("B205").Value
-C205 = Range("C205").Value
-If B205 = C205 Then
-Range("D205").Value = "OK"
-Else
-Range("D205").Value = "NG"
-End If
-End Function
-
-Function test_xlSkipColumn(ByRef num)
-Range("A206").Clear
-Range("B206").Clear
-Range("C206").Clear
-Range("D206").Clear
-Range("A206").Value = "xlSkipColumn"
-Range("B206").Value = 9
-Range("C206").Value = num
-B206 = Range("B206").Value
-C206 = Range("C206").Value
-If B206 = C206 Then
-Range("D206").Value = "OK"
-Else
-Range("D206").Value = "NG"
-End If
-End Function
-
-Function test_xlTextFormat(ByRef num)
-Range("A207").Clear
-Range("B207").Clear
-Range("C207").Clear
-Range("D207").Clear
-Range("A207").Value = "xlTextFormat"
-Range("B207").Value = 2
-Range("C207").Value = num
-B207 = Range("B207").Value
-C207 = Range("C207").Value
-If B207 = C207 Then
-Range("D207").Value = "OK"
-Else
-Range("D207").Value = "NG"
-End If
-End Function
-
-Function test_xlYDMFormat(ByRef num)
-Range("A208").Clear
-Range("B208").Clear
-Range("C208").Clear
-Range("D208").Clear
-Range("A208").Value = "xlYDMFormat"
-Range("B208").Value = 8
-Range("C208").Value = num
-B208 = Range("B208").Value
-C208 = Range("C208").Value
-If B208 = C208 Then
-Range("D208").Value = "OK"
-Else
-Range("D208").Value = "NG"
-End If
-End Function
-
-Function test_xlYMDFormat(ByRef num)
-Range("A209").Clear
-Range("B209").Clear
-Range("C209").Clear
-Range("D209").Clear
-Range("A209").Value = "xlYMDFormat"
-Range("B209").Value = 5
-Range("C209").Value = num
-B209 = Range("B209").Value
-C209 = Range("C209").Value
-If B209 = C209 Then
-Range("D209").Value = "OK"
-Else
-Range("D209").Value = "NG"
-End If
-End Function
-
-Function test_xlCommandUnderlinesAutomatic(ByRef num)
-Range("A210").Clear
-Range("B210").Clear
-Range("C210").Clear
-Range("D210").Clear
-Range("A210").Value = "xlCommandUnderlinesAutomatic"
-Range("B210").Value = -4105
-Range("C210").Value = num
-B210 = Range("B210").Value
-C210 = Range("C210").Value
-If B210 = C210 Then
-Range("D210").Value = "OK"
-Else
-Range("D210").Value = "NG"
-End If
-End Function
-
-Function test_xlCommandUnderlinesOff(ByRef num)
-Range("A211").Clear
-Range("B211").Clear
-Range("C211").Clear
-Range("D211").Clear
-Range("A211").Value = "xlCommandUnderlinesOff"
-Range("B211").Value = -4146
-Range("C211").Value = num
-B211 = Range("B211").Value
-C211 = Range("C211").Value
-If B211 = C211 Then
-Range("D211").Value = "OK"
-Else
-Range("D211").Value = "NG"
-End If
-End Function
-
-Function test_xlCommandUnderlinesOn(ByRef num)
-Range("A212").Clear
-Range("B212").Clear
-Range("C212").Clear
-Range("D212").Clear
-Range("A212").Value = "xlCommandUnderlinesOn"
-Range("B212").Value = 1
-Range("C212").Value = num
-B212 = Range("B212").Value
-C212 = Range("C212").Value
-If B212 = C212 Then
-Range("D212").Value = "OK"
-Else
-Range("D212").Value = "NG"
-End If
-End Function
-
-Function test_xlCommentAndIndicator(ByRef num)
-Range("A213").Clear
-Range("B213").Clear
-Range("C213").Clear
-Range("D213").Clear
-Range("A213").Value = "xlCommentAndIndicator"
-Range("B213").Value = 1
-Range("C213").Value = num
-B213 = Range("B213").Value
-C213 = Range("C213").Value
-If B213 = C213 Then
-Range("D213").Value = "OK"
-Else
-Range("D213").Value = "NG"
-End If
-End Function
-
-Function test_xlCommentIndicatorOnly(ByRef num)
-Range("A214").Clear
-Range("B214").Clear
-Range("C214").Clear
-Range("D214").Clear
-Range("A214").Value = "xlCommentIndicatorOnly"
-Range("B214").Value = -1
-Range("C214").Value = num
-B214 = Range("B214").Value
-C214 = Range("C214").Value
-If B214 = C214 Then
-Range("D214").Value = "OK"
-Else
-Range("D214").Value = "NG"
-End If
-End Function
-
-Function test_xlNoIndicator(ByRef num)
-Range("A215").Clear
-Range("B215").Clear
-Range("C215").Clear
-Range("D215").Clear
-Range("A215").Value = "xlNoIndicator"
-Range("B215").Value = 0
-Range("C215").Value = num
-B215 = Range("B215").Value
-C215 = Range("C215").Value
-If B215 = C215 Then
-Range("D215").Value = "OK"
-Else
-Range("D215").Value = "NG"
-End If
-End Function
-
-Function test_xlAverage(ByRef num)
-Range("A216").Clear
-Range("B216").Clear
-Range("C216").Clear
-Range("D216").Clear
-Range("A216").Value = "xlAverage"
-Range("B216").Value = -4106
-Range("C216").Value = num
-B216 = Range("B216").Value
-C216 = Range("C216").Value
-If B216 = C216 Then
-Range("D216").Value = "OK"
-Else
-Range("D216").Value = "NG"
-End If
-End Function
-
-Function test_xlCount(ByRef num)
-Range("A217").Clear
-Range("B217").Clear
-Range("C217").Clear
-Range("D217").Clear
-Range("A217").Value = "xlCount"
-Range("B217").Value = -4112
-Range("C217").Value = num
-B217 = Range("B217").Value
-C217 = Range("C217").Value
-If B217 = C217 Then
-Range("D217").Value = "OK"
-Else
-Range("D217").Value = "NG"
-End If
-End Function
-
-Function test_xlCountNums(ByRef num)
-Range("A218").Clear
-Range("B218").Clear
-Range("C218").Clear
-Range("D218").Clear
-Range("A218").Value = "xlCountNums"
-Range("B218").Value = -4113
-Range("C218").Value = num
-B218 = Range("B218").Value
-C218 = Range("C218").Value
-If B218 = C218 Then
-Range("D218").Value = "OK"
-Else
-Range("D218").Value = "NG"
-End If
-End Function
-
-Function test_xlMax(ByRef num)
-Range("A219").Clear
-Range("B219").Clear
-Range("C219").Clear
-Range("D219").Clear
-Range("A219").Value = "xlMax"
-Range("B219").Value = -4136
-Range("C219").Value = num
-B219 = Range("B219").Value
-C219 = Range("C219").Value
-If B219 = C219 Then
-Range("D219").Value = "OK"
-Else
-Range("D219").Value = "NG"
-End If
-End Function
-
-Function test_xlMin(ByRef num)
-Range("A220").Clear
-Range("B220").Clear
-Range("C220").Clear
-Range("D220").Clear
-Range("A220").Value = "xlMin"
-Range("B220").Value = -4139
-Range("C220").Value = num
-B220 = Range("B220").Value
-C220 = Range("C220").Value
-If B220 = C220 Then
-Range("D220").Value = "OK"
-Else
-Range("D220").Value = "NG"
-End If
-End Function
-
-Function test_xlProduct(ByRef num)
-Range("A221").Clear
-Range("B221").Clear
-Range("C221").Clear
-Range("D221").Clear
-Range("A221").Value = "xlProduct"
-Range("B221").Value = -4149
-Range("C221").Value = num
-B221 = Range("B221").Value
-C221 = Range("C221").Value
-If B221 = C221 Then
-Range("D221").Value = "OK"
-Else
-Range("D221").Value = "NG"
-End If
-End Function
-
-Function test_xlStDev(ByRef num)
-Range("A222").Clear
-Range("B222").Clear
-Range("C222").Clear
-Range("D222").Clear
-Range("A222").Value = "xlStDev"
-Range("B222").Value = -4155
-Range("C222").Value = num
-B222 = Range("B222").Value
-C222 = Range("C222").Value
-If B222 = C222 Then
-Range("D222").Value = "OK"
-Else
-Range("D222").Value = "NG"
-End If
-End Function
-
-Function test_xlStDevP(ByRef num)
-Range("A223").Clear
-Range("B223").Clear
-Range("C223").Clear
-Range("D223").Clear
-Range("A223").Value = "xlStDevP"
-Range("B223").Value = -4156
-Range("C223").Value = num
-B223 = Range("B223").Value
-C223 = Range("C223").Value
-If B223 = C223 Then
-Range("D223").Value = "OK"
-Else
-Range("D223").Value = "NG"
-End If
-End Function
-
-Function test_xlSum(ByRef num)
-Range("A224").Clear
-Range("B224").Clear
-Range("C224").Clear
-Range("D224").Clear
-Range("A224").Value = "xlSum"
-Range("B224").Value = -4157
-Range("C224").Value = num
-B224 = Range("B224").Value
-C224 = Range("C224").Value
-If B224 = C224 Then
-Range("D224").Value = "OK"
-Else
-Range("D224").Value = "NG"
-End If
-End Function
-
-Function test_xlUnknown(ByRef num)
-Range("A225").Clear
-Range("B225").Clear
-Range("C225").Clear
-Range("D225").Clear
-Range("A225").Value = "xlUnknown"
-Range("B225").Value = 1000
-Range("C225").Value = num
-B225 = Range("B225").Value
-C225 = Range("C225").Value
-If B225 = C225 Then
-Range("D225").Value = "OK"
-Else
-Range("D225").Value = "NG"
-End If
-End Function
-
-Function test_xlVar(ByRef num)
-Range("A226").Clear
-Range("B226").Clear
-Range("C226").Clear
-Range("D226").Clear
-Range("A226").Value = "xlVar"
-Range("B226").Value = -4164
-Range("C226").Value = num
-B226 = Range("B226").Value
-C226 = Range("C226").Value
-If B226 = C226 Then
-Range("D226").Value = "OK"
-Else
-Range("D226").Value = "NG"
-End If
-End Function
-
-Function test_xlVarP(ByRef num)
-Range("A227").Clear
-Range("B227").Clear
-Range("C227").Clear
-Range("D227").Clear
-Range("A227").Value = "xlVarP"
-Range("B227").Value = -4165
-Range("C227").Value = num
-B227 = Range("B227").Value
-C227 = Range("C227").Value
-If B227 = C227 Then
-Range("D227").Value = "OK"
-Else
-Range("D227").Value = "NG"
-End If
-End Function
-
-Function test_xlBitmap(ByRef num)
-Range("A228").Clear
-Range("B228").Clear
-Range("C228").Clear
-Range("D228").Clear
-Range("A228").Value = "xlBitmap"
-Range("B228").Value = 2
-Range("C228").Value = num
-B228 = Range("B228").Value
-C228 = Range("C228").Value
-If B228 = C228 Then
-Range("D228").Value = "OK"
-Else
-Range("D228").Value = "NG"
-End If
-End Function
-
-Function test_xlPicture(ByRef num)
-Range("A229").Clear
-Range("B229").Clear
-Range("C229").Clear
-Range("D229").Clear
-Range("A229").Value = "xlPicture"
-Range("B229").Value = -4147
-Range("C229").Value = num
-B229 = Range("B229").Value
-C229 = Range("C229").Value
-If B229 = C229 Then
-Range("D229").Value = "OK"
-Else
-Range("D229").Value = "NG"
-End If
-End Function
-
-Function test_xlExtractData(ByRef num)
-Range("A230").Clear
-Range("B230").Clear
-Range("C230").Clear
-Range("D230").Clear
-Range("A230").Value = "xlExtractData"
-Range("B230").Value = 2
-Range("C230").Value = num
-B230 = Range("B230").Value
-C230 = Range("C230").Value
-If B230 = C230 Then
-Range("D230").Value = "OK"
-Else
-Range("D230").Value = "NG"
-End If
-End Function
-
-Function test_xlNormalLoad(ByRef num)
-Range("A231").Clear
-Range("B231").Clear
-Range("C231").Clear
-Range("D231").Clear
-Range("A231").Value = "xlNormalLoad"
-Range("B231").Value = 0
-Range("C231").Value = num
-B231 = Range("B231").Value
-C231 = Range("C231").Value
-If B231 = C231 Then
-Range("D231").Value = "OK"
-Else
-Range("D231").Value = "NG"
-End If
-End Function
-
-Function test_xlRepairFile(ByRef num)
-Range("A232").Clear
-Range("B232").Clear
-Range("C232").Clear
-Range("D232").Clear
-Range("A232").Value = "xlRepairFile"
-Range("B232").Value = 1
-Range("C232").Value = num
-B232 = Range("B232").Value
-C232 = Range("C232").Value
-If B232 = C232 Then
-Range("D232").Value = "OK"
-Else
-Range("D232").Value = "NG"
-End If
-End Function
-
-Function test_xlCreatorCode(ByRef num)
-Range("A233").Clear
-Range("B233").Clear
-Range("C233").Clear
-Range("D233").Clear
-Range("A233").Value = "xlCreatorCode"
-Range("B233").Value = 1480803660
-Range("C233").Value = num
-B233 = Range("B233").Value
-C233 = Range("C233").Value
-If B233 = C233 Then
-Range("D233").Value = "OK"
-Else
-Range("D233").Value = "NG"
-End If
-End Function
-
-Function test_xlHierarchy(ByRef num)
-Range("A234").Clear
-Range("B234").Clear
-Range("C234").Clear
-Range("D234").Clear
-Range("A234").Value = "xlHierarchy"
-Range("B234").Value = 1
-Range("C234").Value = num
-B234 = Range("B234").Value
-C234 = Range("C234").Value
-If B234 = C234 Then
-Range("D234").Value = "OK"
-Else
-Range("D234").Value = "NG"
-End If
-End Function
-
-Function test_xlMeasure(ByRef num)
-Range("A235").Clear
-Range("B235").Clear
-Range("C235").Clear
-Range("D235").Clear
-Range("A235").Value = "xlMeasure"
-Range("B235").Value = 2
-Range("C235").Value = num
-B235 = Range("B235").Value
-C235 = Range("C235").Value
-If B235 = C235 Then
-Range("D235").Value = "OK"
-Else
-Range("D235").Value = "NG"
-End If
-End Function
-
-Function test_xlSet(ByRef num)
-Range("A236").Clear
-Range("B236").Clear
-Range("C236").Clear
-Range("D236").Clear
-Range("A236").Value = "xlSet"
-Range("B236").Value = 3
-Range("C236").Value = num
-B236 = Range("B236").Value
-C236 = Range("C236").Value
-If B236 = C236 Then
-Range("D236").Value = "OK"
-Else
-Range("D236").Value = "NG"
-End If
-End Function
-
-Function test_xlCopy(ByRef num)
-Range("A237").Clear
-Range("B237").Clear
-Range("C237").Clear
-Range("D237").Clear
-Range("A237").Value = "xlCopy"
-Range("B237").Value = 1
-Range("C237").Value = num
-B237 = Range("B237").Value
-C237 = Range("C237").Value
-If B237 = C237 Then
-Range("D237").Value = "OK"
-Else
-Range("D237").Value = "NG"
-End If
-End Function
-
-Function test_xlCut(ByRef num)
-Range("A238").Clear
-Range("B238").Clear
-Range("C238").Clear
-Range("D238").Clear
-Range("A238").Value = "xlCut"
-Range("B238").Value = 2
-Range("C238").Value = num
-B238 = Range("B238").Value
-C238 = Range("C238").Value
-If B238 = C238 Then
-Range("D238").Value = "OK"
-Else
-Range("D238").Value = "NG"
-End If
-End Function
-
-Function test_xlValidAlterInformation(ByRef num)
-Range("A239").Clear
-Range("B239").Clear
-Range("C239").Clear
-Range("D239").Clear
-Range("A239").Value = "xlValidAlterInformation"
-Range("B239").Value = 3
-Range("C239").Value = num
-B239 = Range("B239").Value
-C239 = Range("C239").Value
-If B239 = C239 Then
-Range("D239").Value = "OK"
-Else
-Range("D239").Value = "NG"
-End If
-End Function
-
-Function test_xlValidAlterStop(ByRef num)
-Range("A240").Clear
-Range("B240").Clear
-Range("C240").Clear
-Range("D240").Clear
-Range("A240").Value = "xlValidAlterStop"
-Range("B240").Value = 1
-Range("C240").Value = num
-B240 = Range("B240").Value
-C240 = Range("C240").Value
-If B240 = C240 Then
-Range("D240").Value = "OK"
-Else
-Range("D240").Value = "NG"
-End If
-End Function
-
-Function test_xlValidAlterWarning(ByRef num)
-Range("A241").Clear
-Range("B241").Clear
-Range("C241").Clear
-Range("D241").Clear
-Range("A241").Value = "xlValidAlterWarning"
-Range("B241").Value = 2
-Range("C241").Value = num
-B241 = Range("B241").Value
-C241 = Range("C241").Value
-If B241 = C241 Then
-Range("D241").Value = "OK"
-Else
-Range("D241").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateCustom(ByRef num)
-Range("A242").Clear
-Range("B242").Clear
-Range("C242").Clear
-Range("D242").Clear
-Range("A242").Value = "xlValidateCustom"
-Range("B242").Value = 7
-Range("C242").Value = num
-B242 = Range("B242").Value
-C242 = Range("C242").Value
-If B242 = C242 Then
-Range("D242").Value = "OK"
-Else
-Range("D242").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateDate(ByRef num)
-Range("A243").Clear
-Range("B243").Clear
-Range("C243").Clear
-Range("D243").Clear
-Range("A243").Value = "xlValidateDate"
-Range("B243").Value = 4
-Range("C243").Value = num
-B243 = Range("B243").Value
-C243 = Range("C243").Value
-If B243 = C243 Then
-Range("D243").Value = "OK"
-Else
-Range("D243").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateDecimal(ByRef num)
-Range("A244").Clear
-Range("B244").Clear
-Range("C244").Clear
-Range("D244").Clear
-Range("A244").Value = "xlValidateDecimal"
-Range("B244").Value = 2
-Range("C244").Value = num
-B244 = Range("B244").Value
-C244 = Range("C244").Value
-If B244 = C244 Then
-Range("D244").Value = "OK"
-Else
-Range("D244").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateInputOnly(ByRef num)
-Range("A245").Clear
-Range("B245").Clear
-Range("C245").Clear
-Range("D245").Clear
-Range("A245").Value = "xlValidateInputOnly"
-Range("B245").Value = 0
-Range("C245").Value = num
-B245 = Range("B245").Value
-C245 = Range("C245").Value
-If B245 = C245 Then
-Range("D245").Value = "OK"
-Else
-Range("D245").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateList(ByRef num)
-Range("A246").Clear
-Range("B246").Clear
-Range("C246").Clear
-Range("D246").Clear
-Range("A246").Value = "xlValidateList"
-Range("B246").Value = 3
-Range("C246").Value = num
-B246 = Range("B246").Value
-C246 = Range("C246").Value
-If B246 = C246 Then
-Range("D246").Value = "OK"
-Else
-Range("D246").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateTextLength(ByRef num)
-Range("A247").Clear
-Range("B247").Clear
-Range("C247").Clear
-Range("D247").Clear
-Range("A247").Value = "xlValidateTextLength"
-Range("B247").Value = 6
-Range("C247").Value = num
-B247 = Range("B247").Value
-C247 = Range("C247").Value
-If B247 = C247 Then
-Range("D247").Value = "OK"
-Else
-Range("D247").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateTime(ByRef num)
-Range("A248").Clear
-Range("B248").Clear
-Range("C248").Clear
-Range("D248").Clear
-Range("A248").Value = "xlValidateTime"
-Range("B248").Value = 5
-Range("C248").Value = num
-B248 = Range("B248").Value
-C248 = Range("C248").Value
-If B248 = C248 Then
-Range("D248").Value = "OK"
-Else
-Range("D248").Value = "NG"
-End If
-End Function
-
-Function test_xlValidateWholeNumber(ByRef num)
-Range("A249").Clear
-Range("B249").Clear
-Range("C249").Clear
-Range("D249").Clear
-Range("A249").Value = "xlValidateWholeNumber"
-Range("B249").Value = 1
-Range("C249").Value = num
-B249 = Range("B249").Value
-C249 = Range("C249").Value
-If B249 = C249 Then
-Range("D249").Value = "OK"
-Else
-Range("D249").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionAbove(ByRef num)
-Range("A250").Clear
-Range("B250").Clear
-Range("C250").Clear
-Range("D250").Clear
-Range("A250").Value = "xlLabelPositionAbove"
-Range("B250").Value = 0
-Range("C250").Value = num
-B250 = Range("B250").Value
-C250 = Range("C250").Value
-If B250 = C250 Then
-Range("D250").Value = "OK"
-Else
-Range("D250").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionBelow(ByRef num)
-Range("A251").Clear
-Range("B251").Clear
-Range("C251").Clear
-Range("D251").Clear
-Range("A251").Value = "xlLabelPositionBelow"
-Range("B251").Value = 1
-Range("C251").Value = num
-B251 = Range("B251").Value
-C251 = Range("C251").Value
-If B251 = C251 Then
-Range("D251").Value = "OK"
-Else
-Range("D251").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionBestFit(ByRef num)
-Range("A252").Clear
-Range("B252").Clear
-Range("C252").Clear
-Range("D252").Clear
-Range("A252").Value = "xlLabelPositionBestFit"
-Range("B252").Value = 5
-Range("C252").Value = num
-B252 = Range("B252").Value
-C252 = Range("C252").Value
-If B252 = C252 Then
-Range("D252").Value = "OK"
-Else
-Range("D252").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionBestCenter(ByRef num)
-Range("A253").Clear
-Range("B253").Clear
-Range("C253").Clear
-Range("D253").Clear
-Range("A253").Value = "xlLabelPositionBestCenter"
-Range("B253").Value = -4108
-Range("C253").Value = num
-B253 = Range("B253").Value
-C253 = Range("C253").Value
-If B253 = C253 Then
-Range("D253").Value = "OK"
-Else
-Range("D253").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionBestCustom(ByRef num)
-Range("A254").Clear
-Range("B254").Clear
-Range("C254").Clear
-Range("D254").Clear
-Range("A254").Value = "xlLabelPositionBestCustom"
-Range("B254").Value = 7
-Range("C254").Value = num
-B254 = Range("B254").Value
-C254 = Range("C254").Value
-If B254 = C254 Then
-Range("D254").Value = "OK"
-Else
-Range("D254").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionInsideBase(ByRef num)
-Range("A255").Clear
-Range("B255").Clear
-Range("C255").Clear
-Range("D255").Clear
-Range("A255").Value = "xlLabelPositionInsideBase"
-Range("B255").Value = 4
-Range("C255").Value = num
-B255 = Range("B255").Value
-C255 = Range("C255").Value
-If B255 = C255 Then
-Range("D255").Value = "OK"
-Else
-Range("D255").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionInsideEnd(ByRef num)
-Range("A256").Clear
-Range("B256").Clear
-Range("C256").Clear
-Range("D256").Clear
-Range("A256").Value = "xlLabelPositionInsideEnd"
-Range("B256").Value = 3
-Range("C256").Value = num
-B256 = Range("B256").Value
-C256 = Range("C256").Value
-If B256 = C256 Then
-Range("D256").Value = "OK"
-Else
-Range("D256").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionInsideLeft(ByRef num)
-Range("A257").Clear
-Range("B257").Clear
-Range("C257").Clear
-Range("D257").Clear
-Range("A257").Value = "xlLabelPositionInsideLeft"
-Range("B257").Value = -4131
-Range("C257").Value = num
-B257 = Range("B257").Value
-C257 = Range("C257").Value
-If B257 = C257 Then
-Range("D257").Value = "OK"
-Else
-Range("D257").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionMixed(ByRef num)
-Range("A258").Clear
-Range("B258").Clear
-Range("C258").Clear
-Range("D258").Clear
-Range("A258").Value = "xlLabelPositionMixed"
-Range("B258").Value = 6
-Range("C258").Value = num
-B258 = Range("B258").Value
-C258 = Range("C258").Value
-If B258 = C258 Then
-Range("D258").Value = "OK"
-Else
-Range("D258").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionOutsideEnd(ByRef num)
-Range("A259").Clear
-Range("B259").Clear
-Range("C259").Clear
-Range("D259").Clear
-Range("A259").Value = "xlLabelPositionOutsideEnd"
-Range("B259").Value = 2
-Range("C259").Value = num
-B259 = Range("B259").Value
-C259 = Range("C259").Value
-If B259 = C259 Then
-Range("D259").Value = "OK"
-Else
-Range("D259").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelPositionRight(ByRef num)
-Range("A260").Clear
-Range("B260").Clear
-Range("C260").Clear
-Range("D260").Clear
-Range("A260").Value = "xlLabelPositionRight"
-Range("B260").Value = -4152
-Range("C260").Value = num
-B260 = Range("B260").Value
-C260 = Range("C260").Value
-If B260 = C260 Then
-Range("D260").Value = "OK"
-Else
-Range("D260").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelSeparatorDefault(ByRef num)
-Range("A261").Clear
-Range("B261").Clear
-Range("C261").Clear
-Range("D261").Clear
-Range("A261").Value = "xlDataLabelSeparatorDefault"
-Range("B261").Value = 1
-Range("C261").Value = num
-B261 = Range("B261").Value
-C261 = Range("C261").Value
-If B261 = C261 Then
-Range("D261").Value = "OK"
-Else
-Range("D261").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowBubbleSizes(ByRef num)
-Range("A262").Clear
-Range("B262").Clear
-Range("C262").Clear
-Range("D262").Clear
-Range("A262").Value = "xlDataLabelsShowBubbleSizes"
-Range("B262").Value = 6
-Range("C262").Value = num
-B262 = Range("B262").Value
-C262 = Range("C262").Value
-If B262 = C262 Then
-Range("D262").Value = "OK"
-Else
-Range("D262").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowLabel(ByRef num)
-Range("A263").Clear
-Range("B263").Clear
-Range("C263").Clear
-Range("D263").Clear
-Range("A263").Value = "xlDataLabelsShowLabel"
-Range("B263").Value = 4
-Range("C263").Value = num
-B263 = Range("B263").Value
-C263 = Range("C263").Value
-If B263 = C263 Then
-Range("D263").Value = "OK"
-Else
-Range("D263").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowLabelAndPercent(ByRef num)
-Range("A264").Clear
-Range("B264").Clear
-Range("C264").Clear
-Range("D264").Clear
-Range("A264").Value = "xlDataLabelsShowLabelAndPercent"
-Range("B264").Value = 5
-Range("C264").Value = num
-B264 = Range("B264").Value
-C264 = Range("C264").Value
-If B264 = C264 Then
-Range("D264").Value = "OK"
-Else
-Range("D264").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowNone(ByRef num)
-Range("A265").Clear
-Range("B265").Clear
-Range("C265").Clear
-Range("D265").Clear
-Range("A265").Value = "xlDataLabelsShowNone"
-Range("B265").Value = -4142
-Range("C265").Value = num
-B265 = Range("B265").Value
-C265 = Range("C265").Value
-If B265 = C265 Then
-Range("D265").Value = "OK"
-Else
-Range("D265").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowPercent(ByRef num)
-Range("A266").Clear
-Range("B266").Clear
-Range("C266").Clear
-Range("D266").Clear
-Range("A266").Value = "xlDataLabelsShowPercent"
-Range("B266").Value = 3
-Range("C266").Value = num
-B266 = Range("B266").Value
-C266 = Range("C266").Value
-If B266 = C266 Then
-Range("D266").Value = "OK"
-Else
-Range("D266").Value = "NG"
-End If
-End Function
-
-Function test_xlDataLabelsShowValue(ByRef num)
-Range("A267").Clear
-Range("B267").Clear
-Range("C267").Clear
-Range("D267").Clear
-Range("A267").Value = "xlDataLabelsShowValue"
-Range("B267").Value = 2
-Range("C267").Value = num
-B267 = Range("B267").Value
-C267 = Range("C267").Value
-If B267 = C267 Then
-Range("D267").Value = "OK"
-Else
-Range("D267").Value = "NG"
-End If
-End Function
-
-Function test_xlDay(ByRef num)
-Range("A268").Clear
-Range("B268").Clear
-Range("C268").Clear
-Range("D268").Clear
-Range("A268").Value = "xlDay"
-Range("B268").Value = 1
-Range("C268").Value = num
-B268 = Range("B268").Value
-C268 = Range("C268").Value
-If B268 = C268 Then
-Range("D268").Value = "OK"
-Else
-Range("D268").Value = "NG"
-End If
-End Function
-
-Function test_xlMonth(ByRef num)
-Range("A269").Clear
-Range("B269").Clear
-Range("C269").Clear
-Range("D269").Clear
-Range("A269").Value = "xlMonth"
-Range("B269").Value = 3
-Range("C269").Value = num
-B269 = Range("B269").Value
-C269 = Range("C269").Value
-If B269 = C269 Then
-Range("D269").Value = "OK"
-Else
-Range("D269").Value = "NG"
-End If
-End Function
-
-Function test_xlWeekday(ByRef num)
-Range("A270").Clear
-Range("B270").Clear
-Range("C270").Clear
-Range("D270").Clear
-Range("A270").Value = "xlWeekday"
-Range("B270").Value = 2
-Range("C270").Value = num
-B270 = Range("B270").Value
-C270 = Range("C270").Value
-If B270 = C270 Then
-Range("D270").Value = "OK"
-Else
-Range("D270").Value = "NG"
-End If
-End Function
-
-Function test_xlYear(ByRef num)
-Range("A271").Clear
-Range("B271").Clear
-Range("C271").Clear
-Range("D271").Clear
-Range("A271").Value = "xlYear"
-Range("B271").Value = 4
-Range("C271").Value = num
-B271 = Range("B271").Value
-C271 = Range("C271").Value
-If B271 = C271 Then
-Range("D271").Value = "OK"
-Else
-Range("D271").Value = "NG"
-End If
-End Function
-
-Function test_xlAutoFill(ByRef num)
-Range("A272").Clear
-Range("B272").Clear
-Range("C272").Clear
-Range("D272").Clear
-Range("A272").Value = "xlAutoFill"
-Range("B272").Value = 4
-Range("C272").Value = num
-B272 = Range("B272").Value
-C272 = Range("C272").Value
-If B272 = C272 Then
-Range("D272").Value = "OK"
-Else
-Range("D272").Value = "NG"
-End If
-End Function
-
-Function test_xlChronological(ByRef num)
-Range("A273").Clear
-Range("B273").Clear
-Range("C273").Clear
-Range("D273").Clear
-Range("A273").Value = "xlChronological"
-Range("B273").Value = 3
-Range("C273").Value = num
-B273 = Range("B273").Value
-C273 = Range("C273").Value
-If B273 = C273 Then
-Range("D273").Value = "OK"
-Else
-Range("D273").Value = "NG"
-End If
-End Function
-
-Function test_xlDataSeriesLinear(ByRef num)
-Range("A274").Clear
-Range("B274").Clear
-Range("C274").Clear
-Range("D274").Clear
-Range("A274").Value = "xlDataSeriesLinear"
-Range("B274").Value = -4132
-Range("C274").Value = num
-B274 = Range("B274").Value
-C274 = Range("C274").Value
-If B274 = C274 Then
-Range("D274").Value = "OK"
-Else
-Range("D274").Value = "NG"
-End If
-End Function
-
-Function test_xlGrowth(ByRef num)
-Range("A275").Clear
-Range("B275").Clear
-Range("C275").Clear
-Range("D275").Clear
-Range("A275").Value = "xlGrowth"
-Range("B275").Value = 2
-Range("C275").Value = num
-B275 = Range("B275").Value
-C275 = Range("C275").Value
-If B275 = C275 Then
-Range("D275").Value = "OK"
-Else
-Range("D275").Value = "NG"
-End If
-End Function
-
-Function test_xlShiftToLeft(ByRef num)
-Range("A276").Clear
-Range("B276").Clear
-Range("C276").Clear
-Range("D276").Clear
-Range("A276").Value = "xlShiftToLeft"
-Range("B276").Value = -4159
-Range("C276").Value = num
-B276 = Range("B276").Value
-C276 = Range("C276").Value
-If B276 = C276 Then
-Range("D276").Value = "OK"
-Else
-Range("D276").Value = "NG"
-End If
-End Function
-
-Function test_xlShiftUp(ByRef num)
-Range("A277").Clear
-Range("B277").Clear
-Range("C277").Clear
-Range("D277").Clear
-Range("A277").Value = "xlShiftUp"
-Range("B277").Value = -4162
-Range("C277").Value = num
-B277 = Range("B277").Value
-C277 = Range("C277").Value
-If B277 = C277 Then
-Range("D277").Value = "OK"
-Else
-Range("D277").Value = "NG"
-End If
-End Function
-
-Function test_xlDown(ByRef num)
-Range("A278").Clear
-Range("B278").Clear
-Range("C278").Clear
-Range("D278").Clear
-Range("A278").Value = "xlDown"
-Range("B278").Value = -4121
-Range("C278").Value = num
-B278 = Range("B278").Value
-C278 = Range("C278").Value
-If B278 = C278 Then
-Range("D278").Value = "OK"
-Else
-Range("D278").Value = "NG"
-End If
-End Function
-
-Function test_xlToLeft(ByRef num)
-Range("A279").Clear
-Range("B279").Clear
-Range("C279").Clear
-Range("D279").Clear
-Range("A279").Value = "xlToLeft"
-Range("B279").Value = -4159
-Range("C279").Value = num
-B279 = Range("B279").Value
-C279 = Range("C279").Value
-If B279 = C279 Then
-Range("D279").Value = "OK"
-Else
-Range("D279").Value = "NG"
-End If
-End Function
-
-Function test_xlToRight(ByRef num)
-Range("A280").Clear
-Range("B280").Clear
-Range("C280").Clear
-Range("D280").Clear
-Range("A280").Value = "xlToRight"
-Range("B280").Value = -4161
-Range("C280").Value = num
-B280 = Range("B280").Value
-C280 = Range("C280").Value
-If B280 = C280 Then
-Range("D280").Value = "OK"
-Else
-Range("D280").Value = "NG"
-End If
-End Function
-
-Function test_xlUp(ByRef num)
-Range("A281").Clear
-Range("B281").Clear
-Range("C281").Clear
-Range("D281").Clear
-Range("A281").Value = "xlUp"
-Range("B281").Value = -4162
-Range("C281").Value = num
-B281 = Range("B281").Value
-C281 = Range("C281").Value
-If B281 = C281 Then
-Range("D281").Value = "OK"
-Else
-Range("D281").Value = "NG"
-End If
-End Function
-
-Function test_xlInterpolated(ByRef num)
-Range("A282").Clear
-Range("B282").Clear
-Range("C282").Clear
-Range("D282").Clear
-Range("A282").Value = "xlInterpolated"
-Range("B282").Value = 3
-Range("C282").Value = num
-B282 = Range("B282").Value
-C282 = Range("C282").Value
-If B282 = C282 Then
-Range("D282").Value = "OK"
-Else
-Range("D282").Value = "NG"
-End If
-End Function
-
-Function test_xlNotPlotted(ByRef num)
-Range("A283").Clear
-Range("B283").Clear
-Range("C283").Clear
-Range("D283").Clear
-Range("A283").Value = "xlNotPlotted"
-Range("B283").Value = 2
-Range("C283").Value = num
-B283 = Range("B283").Value
-C283 = Range("C283").Value
-If B283 = C283 Then
-Range("D283").Value = "OK"
-Else
-Range("D283").Value = "NG"
-End If
-End Function
-
-Function test_xlZero(ByRef num)
-Range("A284").Clear
-Range("B284").Clear
-Range("C284").Clear
-Range("D284").Clear
-Range("A284").Value = "xlZero"
-Range("B284").Value = 1
-Range("C284").Value = num
-B284 = Range("B284").Value
-C284 = Range("C284").Value
-If B284 = C284 Then
-Range("D284").Value = "OK"
-Else
-Range("D284").Value = "NG"
-End If
-End Function
-
-Function test_xlDisplayShapes(ByRef num)
-Range("A285").Clear
-Range("B285").Clear
-Range("C285").Clear
-Range("D285").Clear
-Range("A285").Value = "xlDisplayShapes"
-Range("B285").Value = -4104
-Range("C285").Value = num
-B285 = Range("B285").Value
-C285 = Range("C285").Value
-If B285 = C285 Then
-Range("D285").Value = "OK"
-Else
-Range("D285").Value = "NG"
-End If
-End Function
-
-Function test_xlHide(ByRef num)
-Range("A286").Clear
-Range("B286").Clear
-Range("C286").Clear
-Range("D286").Clear
-Range("A286").Value = "xlHide"
-Range("B286").Value = 3
-Range("C286").Value = num
-B286 = Range("B286").Value
-C286 = Range("C286").Value
-If B286 = C286 Then
-Range("D286").Value = "OK"
-Else
-Range("D286").Value = "NG"
-End If
-End Function
-
-Function test_xlPlaceholders(ByRef num)
-Range("A287").Clear
-Range("B287").Clear
-Range("C287").Clear
-Range("D287").Clear
-Range("A287").Value = "xlPlaceholders"
-Range("B287").Value = 2
-Range("C287").Value = num
-B287 = Range("B287").Value
-C287 = Range("C287").Value
-If B287 = C287 Then
-Range("D287").Value = "OK"
-Else
-Range("D287").Value = "NG"
-End If
-End Function
-
-Function test_xlHundredMillions(ByRef num)
-Range("A288").Clear
-Range("B288").Clear
-Range("C288").Clear
-Range("D288").Clear
-Range("A288").Value = "xlHundredMillions"
-Range("B288").Value = -8
-Range("C288").Value = num
-B288 = Range("B288").Value
-C288 = Range("C288").Value
-If B288 = C288 Then
-Range("D288").Value = "OK"
-Else
-Range("D288").Value = "NG"
-End If
-End Function
-
-Function test_xlHundreds(ByRef num)
-Range("A289").Clear
-Range("B289").Clear
-Range("C289").Clear
-Range("D289").Clear
-Range("A289").Value = "xlHundreds"
-Range("B289").Value = -2
-Range("C289").Value = num
-B289 = Range("B289").Value
-C289 = Range("C289").Value
-If B289 = C289 Then
-Range("D289").Value = "OK"
-Else
-Range("D289").Value = "NG"
-End If
-End Function
-
-Function test_xlHundredThousands(ByRef num)
-Range("A290").Clear
-Range("B290").Clear
-Range("C290").Clear
-Range("D290").Clear
-Range("A290").Value = "xlHundredThousands"
-Range("B290").Value = -5
-Range("C290").Value = num
-B290 = Range("B290").Value
-C290 = Range("C290").Value
-If B290 = C290 Then
-Range("D290").Value = "OK"
-Else
-Range("D290").Value = "NG"
-End If
-End Function
-
-Function test_xlMillionMillons(ByRef num)
-Range("A291").Clear
-Range("B291").Clear
-Range("C291").Clear
-Range("D291").Clear
-Range("A291").Value = "xlMillionMillons"
-Range("B291").Value = -10
-Range("C291").Value = num
-B291 = Range("B291").Value
-C291 = Range("C291").Value
-If B291 = C291 Then
-Range("D291").Value = "OK"
-Else
-Range("D291").Value = "NG"
-End If
-End Function
-
-Function test_xlMillions(ByRef num)
-Range("A292").Clear
-Range("B292").Clear
-Range("C292").Clear
-Range("D292").Clear
-Range("A292").Value = "xlMillions"
-Range("B292").Value = -6
-Range("C292").Value = num
-B292 = Range("B292").Value
-C292 = Range("C292").Value
-If B292 = C292 Then
-Range("D292").Value = "OK"
-Else
-Range("D292").Value = "NG"
-End If
-End Function
-
-Function test_xlTenMillions(ByRef num)
-Range("A293").Clear
-Range("B293").Clear
-Range("C293").Clear
-Range("D293").Clear
-Range("A293").Value = "xlTenMillions"
-Range("B293").Value = -7
-Range("C293").Value = num
-B293 = Range("B293").Value
-C293 = Range("C293").Value
-If B293 = C293 Then
-Range("D293").Value = "OK"
-Else
-Range("D293").Value = "NG"
-End If
-End Function
-
-Function test_xlTenThousands(ByRef num)
-Range("A294").Clear
-Range("B294").Clear
-Range("C294").Clear
-Range("D294").Clear
-Range("A294").Value = "xlTenThousands"
-Range("B294").Value = -4
-Range("C294").Value = num
-B294 = Range("B294").Value
-C294 = Range("C294").Value
-If B294 = C294 Then
-Range("D294").Value = "OK"
-Else
-Range("D294").Value = "NG"
-End If
-End Function
-
-Function test_xlThousandMillions(ByRef num)
-Range("A295").Clear
-Range("B295").Clear
-Range("C295").Clear
-Range("D295").Clear
-Range("A295").Value = "xlThousandMillions"
-Range("B295").Value = -9
-Range("C295").Value = num
-B295 = Range("B295").Value
-C295 = Range("C295").Value
-If B295 = C295 Then
-Range("D295").Value = "OK"
-Else
-Range("D295").Value = "NG"
-End If
-End Function
-
-Function test_xlThousands(ByRef num)
-Range("A296").Clear
-Range("B296").Clear
-Range("C296").Clear
-Range("D296").Clear
-Range("A296").Value = "xlThousands"
-Range("B296").Value = -3
-Range("C296").Value = num
-B296 = Range("B296").Value
-C296 = Range("C296").Value
-If B296 = C296 Then
-Range("D296").Value = "OK"
-Else
-Range("D296").Value = "NG"
-End If
-End Function
-
-<<<<<<
-======================
-Module5
->>>>>>
-Attribute VB_Name = "Module5"
-
-Sub main_5()
-test_XlEditionFormat (XlEditionFormat)
-test_xlAutomaticUpdate (xlAutomaticUpdate)
-test_xlCancel (xlCancel)
-test_xlChangeAttributes (xlChangeAttributes)
-test_xlManualUpdate (xlManualUpdate)
-test_xlOpenSource (xlOpenSource)
-test_xlSelect (xlSelect)
-test_xlSendPublisher (xlSendPublisher)
-test_xlUpdateSubscriber (xlUpdateSubscriber)
-test_xlPublisher (xlPublisher)
-test_xlSubscriber (xlSubscriber)
-test_xlDisabled (xlDisabled)
-test_xlErrorHandler (xlErrorHandler)
-test_xlInterrupt (xlInterrupt)
-test_xlNoRestrictions (xlNoRestrictions)
-test_xlNoSelection (xlNoSelection)
-test_xlUnlockedCells (xlUnlockedCells)
-test_xlCap (xlCap)
-test_xlNoCap (xlNoCap)
-test_xlX (xlX)
-test_xlY (xlY)
-test_xlErrorBarIncludeBoth (xlErrorBarIncludeBoth)
-test_xlErrorBarIncludeMinusValues (xlErrorBarIncludeMinusValues)
-test_xlErrorBarIncludeNone (xlErrorBarIncludeNone)
-test_xlErrorBarIncludePlusValues (xlErrorBarIncludePlusValues)
-test_xlErrorBarTypeCustom (xlErrorBarTypeCustom)
-test_xlErrorBarTypeFixedValue (xlErrorBarTypeFixedValue)
-test_xlErrorBarTypePercent (xlErrorBarTypePercent)
-test_xlErrorBarTypeStDev (xlErrorBarTypeStDev)
-test_xlErrorBarTypeStError (xlErrorBarTypeStError)
-test_xlEmptyCellReferences (xlEmptyCellReferences)
-test_xlEvaluateToError (xlEvaluateToError)
-test_xlInconsistentFormula (xlInconsistentFormula)
-test_xlListDataValidation (xlListDataValidation)
-test_xlNumberAsText (xlNumberAsText)
-test_xlOmittedCells (xlOmittedCells)
-test_xlTextDate (xlTextDate)
-test_xlUnlockedFormulaCells (xlUnlockedFormulaCells)
-test_xlReadOnly (xlReadOnly)
-test_xlReadWrite (xlReadWrite)
-test_xlAddIn (xlAddIn)
-test_xlCSV (xlCSV)
-test_xlCSVMac (xlCSVMac)
-test_xlCSVMSDOS (xlCSVMSDOS)
-test_xlCSVWindows (xlCSVWindows)
-test_xlCurrentPlatformText (xlCurrentPlatformText)
-test_xlDBF2 (xlDBF2)
-test_xlDBF3 (xlDBF3)
-test_xlDBF4 (xlDBF4)
-test_xlDIF (xlDIF)
-test_xlExcel2 (xlExcel2)
-test_xlExcel2FarEast (xlExcel2FarEast)
-test_xlExcel3 (xlExcel3)
-test_xlExcel4 (xlExcel4)
-test_xlExcel4Wordbook (xlExcel4Wordbook)
-test_xlExcel5 (xlExcel5)
-test_xlExcel7 (xlExcel7)
-test_xlExcel9795 (xlExcel9795)
-test_xlHtml (xlHtml)
-test_xlIntlAddIn (xlIntlAddIn)
-test_xlIntlMacro (xlIntlMacro)
-test_xlSYLK (xlSYLK)
-test_xlTemplate (xlTemplate)
-test_xlTextMac (xlTextMac)
-test_xlTextMSDOS (xlTextMSDOS)
-test_xlTextPrinter (xlTextPrinter)
-test_xlTextWindows (xlTextWindows)
-test_xlUnicodeText (xlUnicodeText)
-test_xlWebArchive (xlWebArchive)
-test_xlWJ2WD1 (xlWJ2WD1)
-test_xlWJ3 (xlWJ3)
-test_xlWJ3FJ3 (xlWJ3FJ3)
-test_xlWK1 (xlWK1)
-test_xlWK1ALL (xlWK1ALL)
-test_xlWK1FMT (xlWK1FMT)
-test_xlWK3 (xlWK3)
-test_xlWK3FM3 (xlWK3FM3)
-test_xlWK4 (xlWK4)
-test_xlWKS (xlWKS)
-test_xlWordbookNormal (xlWordbookNormal)
-test_xlWords2FarEast (xlWords2FarEast)
-test_xlWQ1 (xlWQ1)
-test_xlXMLSpredsheet (xlXMLSpredsheet)
-test_xlFillWithAll (xlFillWithAll)
-test_xlFillWithContents (xlFillWithContents)
-test_xlFillWithFormats (xlFillWithFormats)
-test_xlFilterCopy (xlFilterCopy)
-test_xlFilterInPlace (xlFilterInPlace)
-test_xlComments (xlComments)
-test_xlFormulas (xlFormulas)
-test_xlValues (xlValues)
-test_xlButtonControl (xlButtonControl)
-test_xlCheckBox (xlCheckBox)
-test_xlDropDown (xlDropDown)
-test_xlEditBox (xlEditBox)
-test_xlGroupBox (xlGroupBox)
-test_xlLabel (xlLabel)
-test_xlListBox (xlListBox)
-test_xlOptionButton (xlOptionButton)
-test_xlSchollBar (xlSchollBar)
-test_xlSpinner (xlSpinner)
-test_xlBetween (xlBetween)
-test_xlEqual (xlEqual)
-test_xlGreater (xlGreater)
-test_xlGreaterEqual (xlGreaterEqual)
-test_xlLess (xlLess)
-test_xlLessEqual (xlLessEqual)
-test_xlNotBetween (xlNotBetween)
-test_xlNotEqual (xlNotEqual)
-test_xlCellValue (xlCellValue)
-test_xlExpression (xlExpression)
-test_xlColumnLabels (xlColumnLabels)
-test_xlMixedLabels (xlMixedLabels)
-test_xlNoLabels (xlNoLabels)
-test_xlRowLabels (xlRowLabels)
-test_xlHAlignCenter (xlHAlignCenter)
-test_xlHAlignCenterAcrossSelection (xlHAlignCenterAcrossSelection)
-test_xlHAlignDistributed (xlHAlignDistributed)
-test_xlHAlignFull (xlHAlignFull)
-test_xlHAlignGeneral (xlHAlignGeneral)
-test_xlHAlignJustify (xlHAlignJustify)
-test_xlHAlignLeft (xlHAlignLeft)
-test_xlHAlignRight (xlHAlignRight)
-test_xlHebrewFullScript (xlHebrewFullScript)
-test_xlHebrewMixedAuthorizedScript (xlHebrewMixedAuthorizedScript)
-test_xlHebrewMixedScript (xlHebrewMixedScript)
-test_xlHebrewPartialScript (xlHebrewPartialScript)
-test_xlAllChanges (xlAllChanges)
-test_xlNotYetReviewed (xlNotYetReviewed)
-test_xlSinceMyLastSave (xlSinceMyLastSave)
-test_xlHtmlCalc (xlHtmlCalc)
-test_xlHtmlChart (xlHtmlChart)
-test_xlHtmlList (xlHtmlList)
-test_xlHtmlStatic (xlHtmlStatic)
-test_xlIMEModeAlpha (xlIMEModeAlpha)
-test_xlIMEModeAlphaFull (xlIMEModeAlphaFull)
-test_xlIMEModeDisable (xlIMEModeDisable)
-test_xlIMEModeHangul (xlIMEModeHangul)
-test_xlIMEModeHangulFull (xlIMEModeHangulFull)
-test_xlIMEModeHiragana (xlIMEModeHiragana)
-test_xlIMEModeKatakana (xlIMEModeKatakana)
-test_xlIMEModeKatakanaHalf (xlIMEModeKatakanaHalf)
-test_xlIMEModeNoControl (xlIMEModeNoControl)
-test_xlIMEModeOff (xlIMEModeOff)
-test_xlIMEModeOn (xlIMEModeOn)
-test_xlPivotTableReport (xlPivotTableReport)
-test_xlQueryTable (xlQueryTable)
-test_xlFormatFromLeftOrAbove (xlFormatFromLeftOrAbove)
-test_xlFormatFromRightOrAbove (xlFormatFromRightOrAbove)
-test_xlShiftDown (xlShiftDown)
-test_xlShiftToRight (xlShiftToRight)
-test_xlOutline (xlOutline)
-test_xlTabular (xlTabular)
-test_xlLegendPositionBottom (xlLegendPositionBottom)
-test_xlLegendPositionCorner (xlLegendPositionCorner)
-test_xlLegendPositionLeft (xlLegendPositionLeft)
-test_xlLegendPositionRight (xlLegendPositionRight)
-test_xlLegendPositionTop (xlLegendPositionTop)
-test_xlContinuous (xlContinuous)
-test_xlDash (xlDash)
-test_xlDashDot (xlDashDot)
-test_xlDashDotDot (xlDashDotDot)
-test_xlDot (xlDot)
-test_xlDouble (xlDouble)
-test_xlLineStyleNone (xlLineStyleNone)
-test_xlSlantDashDot (xlSlantDashDot)
-test_xlExcelLink (xlExcelLink)
-test_xlPublishers (xlPublishers)
-test_xlSubscribers (xlSubscribers)
-test_xlEditionDate (xlEditionDate)
-test_xlLinkInfoStatus (xlLinkInfoStatus)
-test_xlUpdateState (xlUpdateState)
-test_xlLinkInfoOLELinks (xlLinkInfoOLELinks)
-test_xlLinkInfoPublishers (xlLinkInfoPublishers)
-test_xlLinkInfoSubscribers (xlLinkInfoSubscribers)
-test_xlLinkStatusCopiedValues (xlLinkStatusCopiedValues)
-test_xlLinkStatusIndeterminate (xlLinkStatusIndeterminate)
-test_xlLinkStatusInvalidName (xlLinkStatusInvalidName)
-test_xlLinkStatusMissingFile (xlLinkStatusMissingFile)
-test_xlLinkStatusMissingSheet (xlLinkStatusMissingSheet)
-test_xlLinkStatusNotStarted (xlLinkStatusNotStarted)
-test_xlLinkStatusOK (xlLinkStatusOK)
-test_xlLinkStatusOld (xlLinkStatusOld)
-test_xlLinkStatusSourceNotCalculated (xlLinkStatusSourceNotCalculated)
-test_xlLinkStatusSourceNotOpen (xlLinkStatusSourceNotOpen)
-test_xlLinkStatusSourceOpen (xlLinkStatusSourceOpen)
-test_xlLinkTypeExcelLinks (xlLinkTypeExcelLinks)
-test_xlLinkTypeOLELinks (xlLinkTypeOLELinks)
-test_xlListConflictDialog (xlListConflictDialog)
-test_xlListConflictDiscardAllConflicts (xlListConflictDiscardAllConflicts)
-test_xlListConflictError (xlListConflictError)
-test_xlListConflictRetryAllConflicts (xlListConflictRetryAllConflicts)
-test_xlListDataTypeCheckbox (xlListDataTypeCheckbox)
-test_xlListDataTypeChoice (xlListDataTypeChoice)
-test_xlListDataTypeChoiceMulti (xlListDataTypeChoiceMulti)
-test_xlListDataTypeCounter (xlListDataTypeCounter)
-test_xlListDataTypeCurrency (xlListDataTypeCurrency)
-test_xlListDataTypeDateTime (xlListDataTypeDateTime)
-test_xlListDataTypeHyperLink (xlListDataTypeHyperLink)
-test_xlListDataTypeListLookup (xlListDataTypeListLookup)
-test_xlListDataTypeMultiLineRichText (xlListDataTypeMultiLineRichText)
-test_xlListDataTypeMultiLineText (xlListDataTypeMultiLineText)
-test_xlListDataTypeNone (xlListDataTypeNone)
-test_xlListDataTypeNumber (xlListDataTypeNumber)
-test_xlListDataTypeText (xlListDataTypeText)
-test_xlSrcExternal (xlSrcExternal)
-test_xlSrcRange (xlSrcRange)
-test_xlSrcXml (xlSrcXml)
-test_xlColumnHeader (xlColumnHeader)
-test_xlColumnItem (xlColumnItem)
-test_xlDataHeader (xlDataHeader)
-test_xlDataItem (xlDataItem)
-test_xlPageHeader (xlPageHeader)
-test_xlPageItem (xlPageItem)
-test_xlRowHeader (xlRowHeader)
-test_xlRowItem (xlRowItem)
-test_xlTableBody (xlTableBody)
-test_xlPart (xlPart)
-test_xlWhole (xlWhole)
-test_xlMicrosoftAccess (xlMicrosoftAccess)
-test_xlMicrosoftFoxPro (xlMicrosoftFoxPro)
-test_xlMicrosoftMail (xlMicrosoftMail)
-test_xlMicrosoftPowerPoint (xlMicrosoftPowerPoint)
-test_xlMicrosoftProject (xlMicrosoftProject)
-test_xlMicrosoftSchedulePlus (xlMicrosoftSchedulePlus)
-test_xlMicrosoftWord (xlMicrosoftWord)
-test_xlMAPI (xlMAPI)
-test_xlNoMailSystem (xlNoMailSystem)
-test_xlPowerTalk (xlPowerTalk)
-test_xlMarkerStyleAutomatic (xlMarkerStyleAutomatic)
-test_xlMarkerStyleCircle (xlMarkerStyleCircle)
-test_xlMarkerStyleDash (xlMarkerStyleDash)
-test_xlMarkerStyleDiamond (xlMarkerStyleDiamond)
-test_xlMarkerStyleDot (xlMarkerStyleDot)
-test_xlMarkerStyleNone (xlMarkerStyleNone)
-test_xlMarkerStylePicture (xlMarkerStylePicture)
-test_xlMarkerStylePlus (xlMarkerStylePlus)
-test_xlMarkerStyleSquare (xlMarkerStyleSquare)
-test_xlMarkerStyleStar (xlMarkerStyleStar)
-test_xlMarkerStyleTiangle (xlMarkerStyleTiangle)
-test_xlMarkerStyleX (xlMarkerStyleX)
-test_xlNoButton (xlNoButton)
-test_xlPrimaryButton (xlPrimaryButton)
-test_xlSecondaryButton (xlSecondaryButton)
-test_xlDefault (xlDefault)
-test_xlIBeam (xlIBeam)
-test_xlNorthwestArrow (xlNorthwestArrow)
-test_xlWait (xlWait)
-test_XlOLEControl (XlOLEControl)
-test_XlOLEEmbed (XlOLEEmbed)
-test_XlOLELink (XlOLELink)
-test_XlVerbOpen (XlVerbOpen)
-test_XlVerbPrimary (XlVerbPrimary)
-test_xlFitToPage (xlFitToPage)
-test_xlFullPage (xlFullPage)
-test_xlScreenSize (xlScreenSize)
-test_xlDownThenOver (xlDownThenOver)
-test_xlOverThenDown (xlOverThenDown)
-test_xlDownward (xlDownward)
-test_xlHorizontal (xlHorizontal)
-test_xlUpward (xlUpward)
-test_xlVertical (xlVertical)
-test_xlBlanks (xlBlanks)
-test_xlButton (xlButton)
-test_xlDataAndLabel (xlDataAndLabel)
-test_xlDataOnly (xlDataOnly)
-test_xlFirstRow (xlFirstRow)
-test_xlLabelOnly (xlLabelOnly)
-test_xlOrigin (xlOrigin)
-test_XlPageBreakAutomatic (XlPageBreakAutomatic)
-test_XlPageBreakManual (XlPageBreakManual)
-test_XlPageBreakNone (XlPageBreakNone)
-test_xlPageBreakFull (xlPageBreakFull)
-test_xlPageBreakPartial (xlPageBreakPartial)
-test_xlLandscape (xlLandscape)
-test_xlPortrait (xlPortrait)
-test_xlPaper10x14 (xlPaper10x14)
-test_xlPaper11x17 (xlPaper11x17)
-test_xlPaperA3 (xlPaperA3)
-test_xlPaperA4Small (xlPaperA4Small)
-test_xlPaperA5 (xlPaperA5)
-test_xlPaperB4 (xlPaperB4)
-test_xlPaperB5 (xlPaperB5)
-test_xlPaperCsheet (xlPaperCsheet)
-test_xlPaperDsheet (xlPaperDsheet)
-test_xlPaperEnvelope10 (xlPaperEnvelope10)
-test_xlPaperEnvelope11 (xlPaperEnvelope11)
-test_xlPaperEnvelope12 (xlPaperEnvelope12)
-test_xlPaperEnvelope14 (xlPaperEnvelope14)
-test_xlPaperEnvelope9 (xlPaperEnvelope9)
-test_xlPaperEnvelopeB4 (xlPaperEnvelopeB4)
-test_xlPaperEnvelopeB5 (xlPaperEnvelopeB5)
-test_xlPaperEnvelopeB6 (xlPaperEnvelopeB6)
-test_xlPaperEnvelopeC3 (xlPaperEnvelopeC3)
-test_xlPaperEnvelopeC4 (xlPaperEnvelopeC4)
-test_xlPaperEnvelopeC5 (xlPaperEnvelopeC5)
-test_xlPaperEnvelopeC6 (xlPaperEnvelopeC6)
-test_xlPaperEnvelopeC65 (xlPaperEnvelopeC65)
-test_xlPaperEnvelopeDL (xlPaperEnvelopeDL)
-test_xlPaperEnvelopeItaly (xlPaperEnvelopeItaly)
-test_xlPaperEnvelopeMonarch (xlPaperEnvelopeMonarch)
-test_xlPaperEnvelopePersonal (xlPaperEnvelopePersonal)
-test_xlPaperEsheet (xlPaperEsheet)
-test_xlPaperExective (xlPaperExective)
-test_xlPaperFanfoldLegalGerman (xlPaperFanfoldLegalGerman)
-test_xlPaperFanfoldStdGerman (xlPaperFanfoldStdGerman)
-test_xlPaperFanfoldUS (xlPaperFanfoldUS)
-test_xlPaperFolio (xlPaperFolio)
-test_xlPaperLedger (xlPaperLedger)
-test_xlPaperLegal (xlPaperLegal)
-test_xlPaperLetter (xlPaperLetter)
-test_xlPaperLetterSmall (xlPaperLetterSmall)
-test_xlPaperNote (xlPaperNote)
-test_xlPaperQuarto (xlPaperQuarto)
-test_xlPaperStatement (xlPaperStatement)
-test_xlPaperTabloid (xlPaperTabloid)
-test_xlPaperUser (xlPaperUser)
-test_xlParameterTypeBigInt (xlParameterTypeBigInt)
-test_xlParameterTypeBinary (xlParameterTypeBinary)
-test_xlParameterTypeBit (xlParameterTypeBit)
-test_xlParameterTypeChar (xlParameterTypeChar)
-test_xlParameterTypeData (xlParameterTypeData)
-test_xlParameterTypeDecimal (xlParameterTypeDecimal)
-test_xlParameterTypeDouble (xlParameterTypeDouble)
-test_xlParameterTypeFloat (xlParameterTypeFloat)
-test_xlParameterTypeInteger (xlParameterTypeInteger)
-test_xlParameterTypeLongVarBinary (xlParameterTypeLongVarBinary)
-test_xlParameterTypeLongVarChar (xlParameterTypeLongVarChar)
-test_xlParameterTypeNumeric (xlParameterTypeNumeric)
-test_xlParameterTypeReal (xlParameterTypeReal)
-test_xlParameterTypeSmallInt (xlParameterTypeSmallInt)
-test_xlParameterTypeTime (xlParameterTypeTime)
-test_xlParameterTypeTimestamp (xlParameterTypeTimestamp)
-test_xlParameterTypeTinyInt (xlParameterTypeTinyInt)
-test_xlParameterTypeUnknown (xlParameterTypeUnknown)
-test_xlParameterTypeVarBinary (xlParameterTypeVarBinary)
-test_xlParameterTypeVarChar (xlParameterTypeVarChar)
-test_xlParameterTypeWChar (xlParameterTypeWChar)
-test_xlConstant (xlConstant)
-test_xlPrompt (xlPrompt)
-test_xlRange (xlRange)
-test_xlPasteSpecialOperationAdd (xlPasteSpecialOperationAdd)
-test_xlPasteSpecialOperationDivide (xlPasteSpecialOperationDivide)
-test_xlPasteSpecialOperationMultiply (xlPasteSpecialOperationMultiply)
-test_xlPasteSpecialOperationNone (xlPasteSpecialOperationNone)
-test_xlPasteSpecialOperationSubstract (xlPasteSpecialOperationSubstract)
-test_xlPasteAll (xlPasteAll)
-test_xlPasteAllExceptBorders (xlPasteAllExceptBorders)
-test_xlPasteAllColumnWidths (xlPasteAllColumnWidths)
-test_xlPasteComments (xlPasteComments)
-test_xlPasteFormats (xlPasteFormats)
-test_xlPasteFormulas (xlPasteFormulas)
-test_xlPasteFormulasAndNumberFormats (xlPasteFormulasAndNumberFormats)
-test_xlPasteValidation (xlPasteValidation)
-test_xlPasteValues (xlPasteValues)
-test_xlPasteValuesAndNumberFormats (xlPasteValuesAndNumberFormats)
-test_xlPatternAutomatic (xlPatternAutomatic)
-test_xlPatternChecker (xlPatternChecker)
-test_xlPatternCrissCross (xlPatternCrissCross)
-test_xlPatternDown (xlPatternDown)
-test_xlPatternGray16 (xlPatternGray16)
-test_xlPatternGray25 (xlPatternGray25)
-test_xlPatternGray50 (xlPatternGray50)
-test_xlPatternGray75 (xlPatternGray75)
-test_xlPatternGray8 (xlPatternGray8)
-test_xlPatternGrid (xlPatternGrid)
-test_xlPatternHorizontal (xlPatternHorizontal)
-test_xlPatternLightDown (xlPatternLightDown)
-test_xlPatternLightHorizontal (xlPatternLightHorizontal)
-test_xlPatternLightUp (xlPatternLightUp)
-test_xlPatternLightVertical (xlPatternLightVertical)
-test_xlPatternNone (xlPatternNone)
-test_xlPatternSemiGray75 (xlPatternSemiGray75)
-test_xlPatternSolid (xlPatternSolid)
-test_xlPatternUp (xlPatternUp)
-test_xlPatternVertical (xlPatternVertical)
-test_XlPhoneticAlignCenter (XlPhoneticAlignCenter)
-test_XlPhoneticAlignDistributed (XlPhoneticAlignDistributed)
-test_XlPhoneticAlignLeft (XlPhoneticAlignLeft)
-test_XlPhoneticAlignNoControl (XlPhoneticAlignNoControl)
-test_xlPrinter (xlPrinter)
-test_xlScreen (xlScreen)
-test_xlBMP (xlBMP)
-test_xlCGM (xlCGM)
-test_xlDRW (xlDRW)
-test_xlDXF (xlDXF)
-test_xlEPS (xlEPS)
-test_xlHGL (xlHGL)
-test_xlPCT (xlPCT)
-test_xlPCX (xlPCX)
-test_xlPIC (xlPIC)
-test_xlPLT (xlPLT)
-test_xlTIF (xlTIF)
-test_xlWMF (xlWMF)
-test_xlWPG (xlWPG)
-test_xlPivotCellBlankCell (xlPivotCellBlankCell)
-test_xlPivotCellCustomSubtotal (xlPivotCellCustomSubtotal)
-test_xlPivotCellDataField (xlPivotCellDataField)
-test_xlPivotCellDataPivotField (xlPivotCellDataPivotField)
-test_xlPivotCellGrandTotal (xlPivotCellGrandTotal)
-test_xlPivotCellPageFieldItem (xlPivotCellPageFieldItem)
-test_xlPivotCellPivotField (xlPivotCellPivotField)
-test_xlPivotCellPivotItem (xlPivotCellPivotItem)
-test_xlPivotCellSubtotal (xlPivotCellSubtotal)
-test_xlPivotCellValue (xlPivotCellValue)
-test_xlDifferenceFrom (xlDifferenceFrom)
-test_xlIndex (xlIndex)
-test_xlNoAdditionalCalculation (xlNoAdditionalCalculation)
-test_xlPercentDifferenceFrom (xlPercentDifferenceFrom)
-test_xlPercentOf (xlPercentOf)
-test_xlPercentOfColumn (xlPercentOfColumn)
-test_xlPercentOfRow (xlPercentOfRow)
-test_xlPercentOfTotal (xlPercentOfTotal)
-test_xlRunningTotal (xlRunningTotal)
-test_xlDate (xlDate)
-test_xlNumber (xlNumber)
-test_xlText (xlText)
-test_xlColumnField (xlColumnField)
-test_xlDataField (xlDataField)
-test_xlHidden (xlHidden)
-test_xlPageField (xlPageField)
-test_xlRowField (xlRowField)
-test_xlPTClassic (xlPTClassic)
-test_xlPTNone (xlPTNone)
-test_xlReport1 (xlReport1)
-test_xlReport10 (xlReport10)
-test_xlReport2 (xlReport2)
-test_xlReport3 (xlReport3)
-test_xlReport4 (xlReport4)
-test_xlReport5 (xlReport5)
-test_xlReport6 (xlReport6)
-test_xlReport7 (xlReport7)
-test_xlReport8 (xlReport8)
-test_xlReport9 (xlReport9)
-test_xlTable1 (xlTable1)
-test_xlTable10 (xlTable10)
-test_xlTable2 (xlTable2)
-test_xlTable3 (xlTable3)
-test_xlTable4 (xlTable4)
-test_xlTable5 (xlTable5)
-test_xlTable6 (xlTable6)
-test_xlTable7 (xlTable7)
-test_xlTable8 (xlTable8)
-test_xlTable9 (xlTable9)
-test_xlMissingItemsDefault (xlMissingItemsDefault)
-test_xlMissingItemsMax (xlMissingItemsMax)
-test_xlMissingItemsNone (xlMissingItemsNone)
-test_xlConsolidation (xlConsolidation)
-test_xlDatabase (xlDatabase)
-test_xlExternal (xlExternal)
-test_xlPivotTable (xlPivotTable)
-test_xlScenario (xlScenario)
-test_xlPivotTableVersion10 (xlPivotTableVersion10)
-test_xlPivotTableVersion2000 (xlPivotTableVersion2000)
-test_xlPivotTableCurrent (xlPivotTableCurrent)
-test_xlFreeFloating (xlFreeFloating)
-test_xlMove (xlMove)
-test_xlMoveAndSize (xlMoveAndSize)
-test_xlMacintosh (xlMacintosh)
-test_xlMSDOS (xlMSDOS)
-test_xlWindows (xlWindows)
-test_xlPrintErrorsBlank (xlPrintErrorsBlank)
-test_xlPrintErrorsDash (xlPrintErrorsDash)
-test_xlPrintErrorsDisplayed (xlPrintErrorsDisplayed)
-test_xlPrintErrorsNA (xlPrintErrorsNA)
-test_xlPrintLocation (xlPrintLocation)
-test_xlPrintNoComments (xlPrintNoComments)
-test_xlPrintSheetEnd (xlPrintSheetEnd)
-test_xlPriorityHigh (xlPriorityHigh)
-test_xlPriorityLow (xlPriorityLow)
-test_xlPriorityNormal (xlPriorityNormal)
-test_xlADORecordset (xlADORecordset)
-test_xlDAORecordset (xlDAORecordset)
-test_xlODBCQuery (xlODBCQuery)
-test_xlOLEDBQuery (xlOLEDBQuery)
-test_xlTextImport (xlTextImport)
-test_xlWebQuery (xlWebQuery)
-test_xlRangeAutoFormat3DEffects1 (xlRangeAutoFormat3DEffects1)
-test_xlRangeAutoFormat3DEffects2 (xlRangeAutoFormat3DEffects2)
-test_xlRangeAutoFormatAccounting1 (xlRangeAutoFormatAccounting1)
-test_xlRangeAutoFormatAccounting2 (xlRangeAutoFormatAccounting2)
-test_xlRangeAutoFormatAccounting3 (xlRangeAutoFormatAccounting3)
-test_xlRangeAutoFormatAccounting4 (xlRangeAutoFormatAccounting4)
-test_xlRangeAutoFormatClassic1 (xlRangeAutoFormatClassic1)
-test_xlRangeAutoFormatClassic2 (xlRangeAutoFormatClassic2)
-test_xlRangeAutoFormatClassic3 (xlRangeAutoFormatClassic3)
-test_xlRangeAutoFormatClassicPivotTable (xlRangeAutoFormatClassicPivotTable)
-test_xlRangeAutoFormatColor1 (xlRangeAutoFormatColor1)
-test_xlRangeAutoFormatColor2 (xlRangeAutoFormatColor2)
-test_xlRangeAutoFormatColor3 (xlRangeAutoFormatColor3)
-test_xlRangeAutoFormatList1 (xlRangeAutoFormatList1)
-test_xlRangeAutoFormatList2 (xlRangeAutoFormatList2)
-test_xlRangeAutoFormatList3 (xlRangeAutoFormatList3)
-test_xlRangeAutoFormatLocalFormat1 (xlRangeAutoFormatLocalFormat1)
-test_xlRangeAutoFormatLocalFormat2 (xlRangeAutoFormatLocalFormat2)
-test_xlRangeAutoFormatLocalFormat3 (xlRangeAutoFormatLocalFormat3)
-test_xlRangeAutoFormatLocalFormat4 (xlRangeAutoFormatLocalFormat4)
-test_xlRangeAutoFormatNone (xlRangeAutoFormatNone)
-test_xlRangeAutoFormatPTNone (xlRangeAutoFormatPTNone)
-test_xlRangeAutoFormatReport1 (xlRangeAutoFormatReport1)
-test_xlRangeAutoFormatReport10 (xlRangeAutoFormatReport10)
-test_xlRangeAutoFormatReport2 (xlRangeAutoFormatReport2)
-test_xlRangeAutoFormatReport3 (xlRangeAutoFormatReport3)
-test_xlRangeAutoFormatReport4 (xlRangeAutoFormatReport4)
-test_xlRangeAutoFormatReport5 (xlRangeAutoFormatReport5)
-test_xlRangeAutoFormatReport6 (xlRangeAutoFormatReport6)
-test_xlRangeAutoFormatReport7 (xlRangeAutoFormatReport7)
-test_xlRangeAutoFormatReport8 (xlRangeAutoFormatReport8)
-test_xlRangeAutoFormatReport9 (xlRangeAutoFormatReport9)
-test_xlRangeAutoFormatSimple (xlRangeAutoFormatSimple)
-test_xlRangeAutoFormatTable1 (xlRangeAutoFormatTable1)
-test_xlRangeAutoFormatTable10 (xlRangeAutoFormatTable10)
-test_xlRangeAutoFormatTable2 (xlRangeAutoFormatTable2)
-test_xlRangeAutoFormatTable3 (xlRangeAutoFormatTable3)
-test_xlRangeAutoFormatTable4 (xlRangeAutoFormatTable4)
-test_xlRangeAutoFormatTable5 (xlRangeAutoFormatTable5)
-test_xlRangeAutoFormatTable6 (xlRangeAutoFormatTable6)
-test_xlRangeAutoFormatTable7 (xlRangeAutoFormatTable7)
-test_xlRangeAutoFormatTable8 (xlRangeAutoFormatTable8)
-test_xlRangeAutoFormatTable9 (xlRangeAutoFormatTable9)
-test_xlRangeValueDefault (xlRangeValueDefault)
-test_xlRangeValueMSPersistXML (xlRangeValueMSPersistXML)
-test_xlRangeValueXMLSpreadsheet (xlRangeValueXMLSpreadsheet)
-test_xlA1 (xlA1)
-test_xlR1C1 (xlR1C1)
-test_xlAbsolute (xlAbsolute)
-test_xlAbsRowRelColumn (xlAbsRowRelColumn)
-test_xlRelative (xlRelative)
-test_xlRelRowAbsColumn (xlRelRowAbsColumn)
-test_xlAlways (xlAlways)
-test_xlAsRequired (xlAsRequired)
-test_xlNever (xlNever)
-test_xlAllAtOnce (xlAllAtOnce)
-test_xlOneAfterAnother (xlOneAfterAnother)
-test_xlNotYetRouted (xlNotYetRouted)
-test_xlRoutingComplete (xlRoutingComplete)
-test_xlRoutingInProgress (xlRoutingInProgress)
-test_xlColumns (xlColumns)
-test_xlRows (xlRows)
-test_xlAutoActivate (xlAutoActivate)
-test_xlAutoClose (xlAutoClose)
-test_xlAutoDeactivate (xlAutoDeactivate)
-test_xlAutoOpen (xlAutoOpen)
-test_xlDoNotSaveChanges (xlDoNotSaveChanges)
-test_xlSaveChanges (xlSaveChanges)
-test_xlExclusive (xlExclusive)
-test_xlNoChange (xlNoChange)
-test_xlShared (xlShared)
-test_xlLocalSessionsChanges (xlLocalSessionsChanges)
-test_xlOtherSessionsChanges (xlOtherSessionsChanges)
-test_xlUserResolution (xlUserResolution)
-test_xlScaleLinear (xlScaleLinear)
-test_xlScaleLogarithmicr (xlScaleLogarithmicr)
-test_xlNext (xlNext)
-test_xlPrevious (xlPrevious)
-test_xlByColumns (xlByColumns)
-test_xlByRows (xlByRows)
-test_xlWithinSheet (xlWithinSheet)
-test_xlWithinWorkbook (xlWithinWorkbook)
-test_xlChart (xlChart)
-test_xlDialogSheet (xlDialogSheet)
-test_xlExcel4IntMacroSheet (xlExcel4IntMacroSheet)
-test_xlExcel4MacroSheet (xlExcel4MacroSheet)
-test_xlWorkSheet (xlWorkSheet)
-test_xlSheetHidden (xlSheetHidden)
-test_xlSheetVeryHidden (xlSheetVeryHidden)
-test_xlSheetVisible (xlSheetVisible)
-test_xlSizeIsArea (xlSizeIsArea)
-test_xlSizeIsWidth (xlSizeIsWidth)
-test_xlSmartTagControlActiveX (xlSmartTagControlActiveX)
-test_xlSmartTagControlButton (xlSmartTagControlButton)
-test_xlSmartTagControlCheckbox (xlSmartTagControlCheckbox)
-test_xlSmartTagControlCombo (xlSmartTagControlCombo)
-test_xlSmartTagControlHelp (xlSmartTagControlHelp)
-test_xlSmartTagControlHelpURL (xlSmartTagControlHelpURL)
-test_xlSmartTagControlImage (xlSmartTagControlImage)
-test_xlSmartTagControlLabel (xlSmartTagControlLabel)
-test_xlSmartTagControlLink (xlSmartTagControlLink)
-test_xlSmartTagControlListbox (xlSmartTagControlListbox)
-test_xlSmartTagControlRadioGroup (xlSmartTagControlRadioGroup)
-test_xlSmartTagControlSeparator (xlSmartTagControlSeparator)
-test_xlSmartTagControlSmartTag (xlSmartTagControlSmartTag)
-test_xlSmartTagControlTextbox (xlSmartTagControlTextbox)
-test_xlButtonOnly (xlButtonOnly)
-test_xlDisplayNone (xlDisplayNone)
-test_xlIndicatorAndButton (xlIndicatorAndButton)
-test_xlSortNormal (xlSortNormal)
-test_xlSortTextAsNumbers (xlSortTextAsNumbers)
-test_xlPinYin (xlPinYin)
-test_xlStroke (xlStroke)
-test_xlCodePage (xlCodePage)
-test_xlSyllabary (xlSyllabary)
-test_xlAscending (xlAscending)
-test_xlDescending (xlDescending)
-test_xlSortColumns (xlSortColumns)
-test_xlSortRows (xlSortRows)
-test_xlSortLabels (xlSortLabels)
-test_xlSortValues (xlSortValues)
-test_xlSourceAutoFilter (xlSourceAutoFilter)
-test_xlSourceChart (xlSourceChart)
-test_xlSourcePivotTable (xlSourcePivotTable)
-test_xlSourcePrintArea (xlSourcePrintArea)
-test_xlSourceQuery (xlSourceQuery)
-test_xlSourceRange (xlSourceRange)
-test_xlSourceSheet (xlSourceSheet)
-test_xlSourceWordbook (xlSourceWordbook)
-test_xlSpeakByColumns (xlSpeakByColumns)
-test_xlSpeakByRows (xlSpeakByRows)
-test_xlErrors (xlErrors)
-test_xlLogical (xlLogical)
-test_xlNumbers (xlNumbers)
-test_xlTextValues (xlTextValues)
-test_xlSubscribeToPicture (xlSubscribeToPicture)
-test_xlSubscribeToText (xlSubscribeToText)
-test_xlAtBottom (xlAtBottom)
-test_xlAtTop (xlAtTop)
-test_xlSummaryOnLeft (xlSummaryOnLeft)
-test_xlSummaryOnRight (xlSummaryOnRight)
-test_xlStandardSummary (xlStandardSummary)
-test_xlSummaryPivotTable (xlSummaryPivotTable)
-test_xlSummaryAbove (xlSummaryAbove)
-test_xlSummaryBelow (xlSummaryBelow)
-test_xlTabPositionFirst (xlTabPositionFirst)
-test_xlTabPositionLast (xlTabPositionLast)
-test_xlDelimited (xlDelimited)
-test_xlFixedWidth (xlFixedWidth)
-test_xlTextQualifierDoubleQuote (xlTextQualifierDoubleQuote)
-test_xlTextQualifierNone (xlTextQualifierNone)
-test_xlTextQualifierSingleQuote (xlTextQualifierSingleQuote)
-test_xlTextVisualLTR (xlTextVisualLTR)
-test_xlTextVisualRTL (xlTextVisualRTL)
-test_XlTickLabelOrientationAutomatic (XlTickLabelOrientationAutomatic)
-test_XlTickLabelOrientationDownward (XlTickLabelOrientationDownward)
-test_XlTickLabelOrientationHorizontal (XlTickLabelOrientationHorizontal)
-test_XlTickLabelOrientationUpward (XlTickLabelOrientationUpward)
-test_XlTickLabelOrientationVertical (XlTickLabelOrientationVertical)
-test_xlTickLabelPositionHigh (xlTickLabelPositionHigh)
-test_xlTickLabelPositionLow (xlTickLabelPositionLow)
-test_xlTickLabelPositionNextToAxis (xlTickLabelPositionNextToAxis)
-test_xlTickLabelPositionNone (xlTickLabelPositionNone)
-test_xlTickMarkCross (xlTickMarkCross)
-test_xlTickMarkInside (xlTickMarkInside)
-test_xlTickMarkNone (xlTickMarkNone)
-test_xlTickMarkOutside (xlTickMarkOutside)
-test_xlDays (xlDays)
-test_xlMonths (xlMonths)
-test_xlYears (xlYears)
-test_xlNoButtonChanges (xlNoButtonChanges)
-test_xlNoChanges (xlNoChanges)
-test_xlNoDockingChanges (xlNoDockingChanges)
-test_xlNoShapeChanges (xlNoShapeChanges)
-test_xlToolbarProtectionNone (xlToolbarProtectionNone)
-test_xlTotalsCalculationAverage (xlTotalsCalculationAverage)
-test_xlTotalsCalculationCount (xlTotalsCalculationCount)
-test_xlTotalsCalculationCountNums (xlTotalsCalculationCountNums)
-test_xlTotalsCalculationCountMax (xlTotalsCalculationCountMax)
-test_xlTotalsCalculationCountMin (xlTotalsCalculationCountMin)
-test_xlTotalsCalculationCountNone (xlTotalsCalculationCountNone)
-test_xlTotalsCalculationCountStdDev (xlTotalsCalculationCountStdDev)
-test_xlTotalsCalculationCountSum (xlTotalsCalculationCountSum)
-test_xlTotalsCalculationCountVar (xlTotalsCalculationCountVar)
-test_xlExponential (xlExponential)
-test_xlLinear (xlLinear)
-test_xlLogarithmic (xlLogarithmic)
-test_xlMovingAvg (xlMovingAvg)
-test_xlPolynomial (xlPolynomial)
-test_xlPower (xlPower)
-test_XlUnderlineStyleDouble (XlUnderlineStyleDouble)
-test_XlUnderlineStyleDoubleAccounting (XlUnderlineStyleDoubleAccounting)
-test_XlUnderlineStyleNone (XlUnderlineStyleNone)
-test_XlUnderlineStyleSingle (XlUnderlineStyleSingle)
-test_XlUnderlineStyleSingleAccounting (XlUnderlineStyleSingleAccounting)
-test_XlUpdateLinksAlways (XlUpdateLinksAlways)
-test_XlUpdateLinksNever (XlUpdateLinksNever)
-test_XlUpdateLinksUserSetting (XlUpdateLinksUserSetting)
-test_xlVAlignBottom (xlVAlignBottom)
-test_xlVAlignCenter (xlVAlignCenter)
-test_xlVAlignDistributed (xlVAlignDistributed)
-test_xlVAlignJustify (xlVAlignJustify)
-test_xlVAlignTop (xlVAlignTop)
-test_XlWBATChart (XlWBATChart)
-test_XlWBATExcel4IntlMacroSheet (XlWBATExcel4IntlMacroSheet)
-test_XlWBATExcel4MacroSheet (XlWBATExcel4MacroSheet)
-test_XlWBATWorksheet (XlWBATWorksheet)
-test_xlWebFormattingAll (xlWebFormattingAll)
-test_xlWebFormattingNone (xlWebFormattingNone)
-test_xlWebFormattingRTF (xlWebFormattingRTF)
-test_xlAllTables (xlAllTables)
-test_xlEntirePage (xlEntirePage)
-test_xlSpecifiedTables (xlSpecifiedTables)
-test_xlMaximized (xlMaximized)
-test_xlMinimized (xlMinimized)
-test_xlNormal (xlNormal)
-test_xlChartAsWindow (xlChartAsWindow)
-test_xlChartInPlace (xlChartInPlace)
-test_xlClipboard (xlClipboard)
-test_xlInfo (xlInfo)
-test_xlWordbook (xlWordbook)
-test_xlNormalView (xlNormalView)
-test_xlPageBreakPreview (xlPageBreakPreview)
-test_xlCommand (xlCommand)
-test_xlFunction (xlFunction)
-test_xlnotXLM (xlnotXLM)
-test_xlXmlExportSuccess (xlXmlExportSuccess)
-test_xlXmlExportValidationFailed (xlXmlExportValidationFailed)
-test_xlXmlImportElementsTruncated (xlXmlImportElementsTruncated)
-test_xlXmlImportSuccess (xlXmlImportSuccess)
-test_xlXmlImportValidationFailed (xlXmlImportValidationFailed)
-test_xlXmlLoadImportToList (xlXmlLoadImportToList)
-test_xlXmlLoadMapXml (xlXmlLoadMapXml)
-test_xlXmlLoadOpenXml (xlXmlLoadOpenXml)
-test_xlXmlLoadPromptUser (xlXmlLoadPromptUser)
-test_xlGuess (xlGuess)
-test_xlNo (xlNo)
-test_xlYes (xlYes)
-Range("A1").Value = "constant name"
-Range("B1").Value = "OOo result"
-Range("C1").Value = "Excel result"
-Range("D1").Value = "Correct?"
-End Sub
-
-Function test_XlEditionFormat(ByRef num)
-Range("A2").Clear
-Range("B2").Clear
-Range("C2").Clear
-Range("D2").Clear
-Range("A2").Value = "XlEditionFormat"
-Range("B2").Value = 0
-Range("C2").Value = num
-B2 = Range("B2").Value
-C2 = Range("C2").Value
-If B2 = C2 Then
-Range("D2").Value = "OK"
-Else
-Range("D2").Value = "NG"
-End If
-End Function
-
-Function test_xlAutomaticUpdate(ByRef num)
-Range("A3").Clear
-Range("B3").Clear
-Range("C3").Clear
-Range("D3").Clear
-Range("A3").Value = "xlAutomaticUpdate"
-Range("B3").Value = 4
-Range("C3").Value = num
-B3 = Range("B3").Value
-C3 = Range("C3").Value
-If B3 = C3 Then
-Range("D3").Value = "OK"
-Else
-Range("D3").Value = "NG"
-End If
-End Function
-
-Function test_xlCancel(ByRef num)
-Range("A4").Clear
-Range("B4").Clear
-Range("C4").Clear
-Range("D4").Clear
-Range("A4").Value = "xlCancel"
-Range("B4").Value = 1
-Range("C4").Value = num
-B4 = Range("B4").Value
-C4 = Range("C4").Value
-If B4 = C4 Then
-Range("D4").Value = "OK"
-Else
-Range("D4").Value = "NG"
-End If
-End Function
-
-Function test_xlChangeAttributes(ByRef num)
-Range("A5").Clear
-Range("B5").Clear
-Range("C5").Clear
-Range("D5").Clear
-Range("A5").Value = "xlChangeAttributes"
-Range("B5").Value = 6
-Range("C5").Value = num
-B5 = Range("B5").Value
-C5 = Range("C5").Value
-If B5 = C5 Then
-Range("D5").Value = "OK"
-Else
-Range("D5").Value = "NG"
-End If
-End Function
-
-Function test_xlManualUpdate(ByRef num)
-Range("A6").Clear
-Range("B6").Clear
-Range("C6").Clear
-Range("D6").Clear
-Range("A6").Value = "xlManualUpdate"
-Range("B6").Value = 5
-Range("C6").Value = num
-B6 = Range("B6").Value
-C6 = Range("C6").Value
-If B6 = C6 Then
-Range("D6").Value = "OK"
-Else
-Range("D6").Value = "NG"
-End If
-End Function
-
-Function test_xlOpenSource(ByRef num)
-Range("A7").Clear
-Range("B7").Clear
-Range("C7").Clear
-Range("D7").Clear
-Range("A7").Value = "xlOpenSource"
-Range("B7").Value = 3
-Range("C7").Value = num
-B7 = Range("B7").Value
-C7 = Range("C7").Value
-If B7 = C7 Then
-Range("D7").Value = "OK"
-Else
-Range("D7").Value = "NG"
-End If
-End Function
-
-Function test_xlSelect(ByRef num)
-Range("A8").Clear
-Range("B8").Clear
-Range("C8").Clear
-Range("D8").Clear
-Range("A8").Value = "xlSelect"
-Range("B8").Value = 3
-Range("C8").Value = num
-B8 = Range("B8").Value
-C8 = Range("C8").Value
-If B8 = C8 Then
-Range("D8").Value = "OK"
-Else
-Range("D8").Value = "NG"
-End If
-End Function
-
-Function test_xlSendPublisher(ByRef num)
-Range("A9").Clear
-Range("B9").Clear
-Range("C9").Clear
-Range("D9").Clear
-Range("A9").Value = "xlSendPublisher"
-Range("B9").Value = 2
-Range("C9").Value = num
-B9 = Range("B9").Value
-C9 = Range("C9").Value
-If B9 = C9 Then
-Range("D9").Value = "OK"
-Else
-Range("D9").Value = "NG"
-End If
-End Function
-
-Function test_xlUpdateSubscriber(ByRef num)
-Range("A10").Clear
-Range("B10").Clear
-Range("C10").Clear
-Range("D10").Clear
-Range("A10").Value = "xlUpdateSubscriber"
-Range("B10").Value = 2
-Range("C10").Value = num
-B10 = Range("B10").Value
-C10 = Range("C10").Value
-If B10 = C10 Then
-Range("D10").Value = "OK"
-Else
-Range("D10").Value = "NG"
-End If
-End Function
-
-Function test_xlPublisher(ByRef num)
-Range("A11").Clear
-Range("B11").Clear
-Range("C11").Clear
-Range("D11").Clear
-Range("A11").Value = "xlPublisher"
-Range("B11").Value = 1
-Range("C11").Value = num
-B11 = Range("B11").Value
-C11 = Range("C11").Value
-If B11 = C11 Then
-Range("D11").Value = "OK"
-Else
-Range("D11").Value = "NG"
-End If
-End Function
-
-Function test_xlSubscriber(ByRef num)
-Range("A12").Clear
-Range("B12").Clear
-Range("C12").Clear
-Range("D12").Clear
-Range("A12").Value = "xlSubscriber"
-Range("B12").Value = 2
-Range("C12").Value = num
-B12 = Range("B12").Value
-C12 = Range("C12").Value
-If B12 = C12 Then
-Range("D12").Value = "OK"
-Else
-Range("D12").Value = "NG"
-End If
-End Function
-
-Function test_xlDisabled(ByRef num)
-Range("A13").Clear
-Range("B13").Clear
-Range("C13").Clear
-Range("D13").Clear
-Range("A13").Value = "xlDisabled"
-Range("B13").Value = 0
-Range("C13").Value = num
-B13 = Range("B13").Value
-C13 = Range("C13").Value
-If B13 = C13 Then
-Range("D13").Value = "OK"
-Else
-Range("D13").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorHandler(ByRef num)
-Range("A14").Clear
-Range("B14").Clear
-Range("C14").Clear
-Range("D14").Clear
-Range("A14").Value = "xlErrorHandler"
-Range("B14").Value = 2
-Range("C14").Value = num
-B14 = Range("B14").Value
-C14 = Range("C14").Value
-If B14 = C14 Then
-Range("D14").Value = "OK"
-Else
-Range("D14").Value = "NG"
-End If
-End Function
-
-Function test_xlInterrupt(ByRef num)
-Range("A15").Clear
-Range("B15").Clear
-Range("C15").Clear
-Range("D15").Clear
-Range("A15").Value = "xlInterrupt"
-Range("B15").Value = 1
-Range("C15").Value = num
-B15 = Range("B15").Value
-C15 = Range("C15").Value
-If B15 = C15 Then
-Range("D15").Value = "OK"
-Else
-Range("D15").Value = "NG"
-End If
-End Function
-
-Function test_xlNoRestrictions(ByRef num)
-Range("A16").Clear
-Range("B16").Clear
-Range("C16").Clear
-Range("D16").Clear
-Range("A16").Value = "xlNoRestrictions"
-Range("B16").Value = 0
-Range("C16").Value = num
-B16 = Range("B16").Value
-C16 = Range("C16").Value
-If B16 = C16 Then
-Range("D16").Value = "OK"
-Else
-Range("D16").Value = "NG"
-End If
-End Function
-
-Function test_xlNoSelection(ByRef num)
-Range("A17").Clear
-Range("B17").Clear
-Range("C17").Clear
-Range("D17").Clear
-Range("A17").Value = "xlNoSelection"
-Range("B17").Value = -4142
-Range("C17").Value = num
-B17 = Range("B17").Value
-C17 = Range("C17").Value
-If B17 = C17 Then
-Range("D17").Value = "OK"
-Else
-Range("D17").Value = "NG"
-End If
-End Function
-
-Function test_xlUnlockedCells(ByRef num)
-Range("A18").Clear
-Range("B18").Clear
-Range("C18").Clear
-Range("D18").Clear
-Range("A18").Value = "xlUnlockedCells"
-Range("B18").Value = 1
-Range("C18").Value = num
-B18 = Range("B18").Value
-C18 = Range("C18").Value
-If B18 = C18 Then
-Range("D18").Value = "OK"
-Else
-Range("D18").Value = "NG"
-End If
-End Function
-
-Function test_xlCap(ByRef num)
-Range("A19").Clear
-Range("B19").Clear
-Range("C19").Clear
-Range("D19").Clear
-Range("A19").Value = "xlCap"
-Range("B19").Value = 1
-Range("C19").Value = num
-B19 = Range("B19").Value
-C19 = Range("C19").Value
-If B19 = C19 Then
-Range("D19").Value = "OK"
-Else
-Range("D19").Value = "NG"
-End If
-End Function
-
-Function test_xlNoCap(ByRef num)
-Range("A20").Clear
-Range("B20").Clear
-Range("C20").Clear
-Range("D20").Clear
-Range("A20").Value = "xlNoCap"
-Range("B20").Value = 2
-Range("C20").Value = num
-B20 = Range("B20").Value
-C20 = Range("C20").Value
-If B20 = C20 Then
-Range("D20").Value = "OK"
-Else
-Range("D20").Value = "NG"
-End If
-End Function
-
-Function test_xlX(ByRef num)
-Range("A21").Clear
-Range("B21").Clear
-Range("C21").Clear
-Range("D21").Clear
-Range("A21").Value = "xlX"
-Range("B21").Value = -4168
-Range("C21").Value = num
-B21 = Range("B21").Value
-C21 = Range("C21").Value
-If B21 = C21 Then
-Range("D21").Value = "OK"
-Else
-Range("D21").Value = "NG"
-End If
-End Function
-
-Function test_xlY(ByRef num)
-Range("A22").Clear
-Range("B22").Clear
-Range("C22").Clear
-Range("D22").Clear
-Range("A22").Value = "xlY"
-Range("B22").Value = 1
-Range("C22").Value = num
-B22 = Range("B22").Value
-C22 = Range("C22").Value
-If B22 = C22 Then
-Range("D22").Value = "OK"
-Else
-Range("D22").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarIncludeBoth(ByRef num)
-Range("A23").Clear
-Range("B23").Clear
-Range("C23").Clear
-Range("D23").Clear
-Range("A23").Value = "xlErrorBarIncludeBoth"
-Range("B23").Value = 1
-Range("C23").Value = num
-B23 = Range("B23").Value
-C23 = Range("C23").Value
-If B23 = C23 Then
-Range("D23").Value = "OK"
-Else
-Range("D23").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarIncludeMinusValues(ByRef num)
-Range("A24").Clear
-Range("B24").Clear
-Range("C24").Clear
-Range("D24").Clear
-Range("A24").Value = "xlErrorBarIncludeMinusValues"
-Range("B24").Value = 3
-Range("C24").Value = num
-B24 = Range("B24").Value
-C24 = Range("C24").Value
-If B24 = C24 Then
-Range("D24").Value = "OK"
-Else
-Range("D24").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarIncludeNone(ByRef num)
-Range("A25").Clear
-Range("B25").Clear
-Range("C25").Clear
-Range("D25").Clear
-Range("A25").Value = "xlErrorBarIncludeNone"
-Range("B25").Value = -4142
-Range("C25").Value = num
-B25 = Range("B25").Value
-C25 = Range("C25").Value
-If B25 = C25 Then
-Range("D25").Value = "OK"
-Else
-Range("D25").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarIncludePlusValues(ByRef num)
-Range("A26").Clear
-Range("B26").Clear
-Range("C26").Clear
-Range("D26").Clear
-Range("A26").Value = "xlErrorBarIncludePlusValues"
-Range("B26").Value = 2
-Range("C26").Value = num
-B26 = Range("B26").Value
-C26 = Range("C26").Value
-If B26 = C26 Then
-Range("D26").Value = "OK"
-Else
-Range("D26").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarTypeCustom(ByRef num)
-Range("A27").Clear
-Range("B27").Clear
-Range("C27").Clear
-Range("D27").Clear
-Range("A27").Value = "xlErrorBarTypeCustom"
-Range("B27").Value = -4144
-Range("C27").Value = num
-B27 = Range("B27").Value
-C27 = Range("C27").Value
-If B27 = C27 Then
-Range("D27").Value = "OK"
-Else
-Range("D27").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarTypeFixedValue(ByRef num)
-Range("A28").Clear
-Range("B28").Clear
-Range("C28").Clear
-Range("D28").Clear
-Range("A28").Value = "xlErrorBarTypeFixedValue"
-Range("B28").Value = 1
-Range("C28").Value = num
-B28 = Range("B28").Value
-C28 = Range("C28").Value
-If B28 = C28 Then
-Range("D28").Value = "OK"
-Else
-Range("D28").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarTypePercent(ByRef num)
-Range("A29").Clear
-Range("B29").Clear
-Range("C29").Clear
-Range("D29").Clear
-Range("A29").Value = "xlErrorBarTypePercent"
-Range("B29").Value = 2
-Range("C29").Value = num
-B29 = Range("B29").Value
-C29 = Range("C29").Value
-If B29 = C29 Then
-Range("D29").Value = "OK"
-Else
-Range("D29").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarTypeStDev(ByRef num)
-Range("A30").Clear
-Range("B30").Clear
-Range("C30").Clear
-Range("D30").Clear
-Range("A30").Value = "xlErrorBarTypeStDev"
-Range("B30").Value = -4155
-Range("C30").Value = num
-B30 = Range("B30").Value
-C30 = Range("C30").Value
-If B30 = C30 Then
-Range("D30").Value = "OK"
-Else
-Range("D30").Value = "NG"
-End If
-End Function
-
-Function test_xlErrorBarTypeStError(ByRef num)
-Range("A31").Clear
-Range("B31").Clear
-Range("C31").Clear
-Range("D31").Clear
-Range("A31").Value = "xlErrorBarTypeStError"
-Range("B31").Value = 4
-Range("C31").Value = num
-B31 = Range("B31").Value
-C31 = Range("C31").Value
-If B31 = C31 Then
-Range("D31").Value = "OK"
-Else
-Range("D31").Value = "NG"
-End If
-End Function
-
-Function test_xlEmptyCellReferences(ByRef num)
-Range("A32").Clear
-Range("B32").Clear
-Range("C32").Clear
-Range("D32").Clear
-Range("A32").Value = "xlEmptyCellReferences"
-Range("B32").Value = 7
-Range("C32").Value = num
-B32 = Range("B32").Value
-C32 = Range("C32").Value
-If B32 = C32 Then
-Range("D32").Value = "OK"
-Else
-Range("D32").Value = "NG"
-End If
-End Function
-
-Function test_xlEvaluateToError(ByRef num)
-Range("A33").Clear
-Range("B33").Clear
-Range("C33").Clear
-Range("D33").Clear
-Range("A33").Value = "xlEvaluateToError"
-Range("B33").Value = 1
-Range("C33").Value = num
-B33 = Range("B33").Value
-C33 = Range("C33").Value
-If B33 = C33 Then
-Range("D33").Value = "OK"
-Else
-Range("D33").Value = "NG"
-End If
-End Function
-
-Function test_xlInconsistentFormula(ByRef num)
-Range("A34").Clear
-Range("B34").Clear
-Range("C34").Clear
-Range("D34").Clear
-Range("A34").Value = "xlInconsistentFormula"
-Range("B34").Value = 4
-Range("C34").Value = num
-B34 = Range("B34").Value
-C34 = Range("C34").Value
-If B34 = C34 Then
-Range("D34").Value = "OK"
-Else
-Range("D34").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataValidation(ByRef num)
-Range("A35").Clear
-Range("B35").Clear
-Range("C35").Clear
-Range("D35").Clear
-Range("A35").Value = "xlListDataValidation"
-Range("B35").Value = 8
-Range("C35").Value = num
-B35 = Range("B35").Value
-C35 = Range("C35").Value
-If B35 = C35 Then
-Range("D35").Value = "OK"
-Else
-Range("D35").Value = "NG"
-End If
-End Function
-
-Function test_xlNumberAsText(ByRef num)
-Range("A36").Clear
-Range("B36").Clear
-Range("C36").Clear
-Range("D36").Clear
-Range("A36").Value = "xlNumberAsText"
-Range("B36").Value = 3
-Range("C36").Value = num
-B36 = Range("B36").Value
-C36 = Range("C36").Value
-If B36 = C36 Then
-Range("D36").Value = "OK"
-Else
-Range("D36").Value = "NG"
-End If
-End Function
-
-Function test_xlOmittedCells(ByRef num)
-Range("A37").Clear
-Range("B37").Clear
-Range("C37").Clear
-Range("D37").Clear
-Range("A37").Value = "xlOmittedCells"
-Range("B37").Value = 5
-Range("C37").Value = num
-B37 = Range("B37").Value
-C37 = Range("C37").Value
-If B37 = C37 Then
-Range("D37").Value = "OK"
-Else
-Range("D37").Value = "NG"
-End If
-End Function
-
-Function test_xlTextDate(ByRef num)
-Range("A38").Clear
-Range("B38").Clear
-Range("C38").Clear
-Range("D38").Clear
-Range("A38").Value = "xlTextDate"
-Range("B38").Value = 2
-Range("C38").Value = num
-B38 = Range("B38").Value
-C38 = Range("C38").Value
-If B38 = C38 Then
-Range("D38").Value = "OK"
-Else
-Range("D38").Value = "NG"
-End If
-End Function
-
-Function test_xlUnlockedFormulaCells(ByRef num)
-Range("A39").Clear
-Range("B39").Clear
-Range("C39").Clear
-Range("D39").Clear
-Range("A39").Value = "xlUnlockedFormulaCells"
-Range("B39").Value = 6
-Range("C39").Value = num
-B39 = Range("B39").Value
-C39 = Range("C39").Value
-If B39 = C39 Then
-Range("D39").Value = "OK"
-Else
-Range("D39").Value = "NG"
-End If
-End Function
-
-Function test_xlReadOnly(ByRef num)
-Range("A40").Clear
-Range("B40").Clear
-Range("C40").Clear
-Range("D40").Clear
-Range("A40").Value = "xlReadOnly"
-Range("B40").Value = 3
-Range("C40").Value = num
-B40 = Range("B40").Value
-C40 = Range("C40").Value
-If B40 = C40 Then
-Range("D40").Value = "OK"
-Else
-Range("D40").Value = "NG"
-End If
-End Function
-
-Function test_xlReadWrite(ByRef num)
-Range("A41").Clear
-Range("B41").Clear
-Range("C41").Clear
-Range("D41").Clear
-Range("A41").Value = "xlReadWrite"
-Range("B41").Value = 2
-Range("C41").Value = num
-B41 = Range("B41").Value
-C41 = Range("C41").Value
-If B41 = C41 Then
-Range("D41").Value = "OK"
-Else
-Range("D41").Value = "NG"
-End If
-End Function
-
-Function test_xlAddIn(ByRef num)
-Range("A42").Clear
-Range("B42").Clear
-Range("C42").Clear
-Range("D42").Clear
-Range("A42").Value = "xlAddIn"
-Range("B42").Value = 18
-Range("C42").Value = num
-B42 = Range("B42").Value
-C42 = Range("C42").Value
-If B42 = C42 Then
-Range("D42").Value = "OK"
-Else
-Range("D42").Value = "NG"
-End If
-End Function
-
-Function test_xlCSV(ByRef num)
-Range("A43").Clear
-Range("B43").Clear
-Range("C43").Clear
-Range("D43").Clear
-Range("A43").Value = "xlCSV"
-Range("B43").Value = 6
-Range("C43").Value = num
-B43 = Range("B43").Value
-C43 = Range("C43").Value
-If B43 = C43 Then
-Range("D43").Value = "OK"
-Else
-Range("D43").Value = "NG"
-End If
-End Function
-
-Function test_xlCSVMac(ByRef num)
-Range("A44").Clear
-Range("B44").Clear
-Range("C44").Clear
-Range("D44").Clear
-Range("A44").Value = "xlCSVMac"
-Range("B44").Value = 22
-Range("C44").Value = num
-B44 = Range("B44").Value
-C44 = Range("C44").Value
-If B44 = C44 Then
-Range("D44").Value = "OK"
-Else
-Range("D44").Value = "NG"
-End If
-End Function
-
-Function test_xlCSVMSDOS(ByRef num)
-Range("A45").Clear
-Range("B45").Clear
-Range("C45").Clear
-Range("D45").Clear
-Range("A45").Value = "xlCSVMSDOS"
-Range("B45").Value = 24
-Range("C45").Value = num
-B45 = Range("B45").Value
-C45 = Range("C45").Value
-If B45 = C45 Then
-Range("D45").Value = "OK"
-Else
-Range("D45").Value = "NG"
-End If
-End Function
-
-Function test_xlCSVWindows(ByRef num)
-Range("A46").Clear
-Range("B46").Clear
-Range("C46").Clear
-Range("D46").Clear
-Range("A46").Value = "xlCSVWindows"
-Range("B46").Value = 23
-Range("C46").Value = num
-B46 = Range("B46").Value
-C46 = Range("C46").Value
-If B46 = C46 Then
-Range("D46").Value = "OK"
-Else
-Range("D46").Value = "NG"
-End If
-End Function
-
-Function test_xlCurrentPlatformText(ByRef num)
-Range("A47").Clear
-Range("B47").Clear
-Range("C47").Clear
-Range("D47").Clear
-Range("A47").Value = "xlCurrentPlatformText"
-Range("B47").Value = -4158
-Range("C47").Value = num
-B47 = Range("B47").Value
-C47 = Range("C47").Value
-If B47 = C47 Then
-Range("D47").Value = "OK"
-Else
-Range("D47").Value = "NG"
-End If
-End Function
-
-Function test_xlDBF2(ByRef num)
-Range("A48").Clear
-Range("B48").Clear
-Range("C48").Clear
-Range("D48").Clear
-Range("A48").Value = "xlDBF2"
-Range("B48").Value = 7
-Range("C48").Value = num
-B48 = Range("B48").Value
-C48 = Range("C48").Value
-If B48 = C48 Then
-Range("D48").Value = "OK"
-Else
-Range("D48").Value = "NG"
-End If
-End Function
-
-Function test_xlDBF3(ByRef num)
-Range("A49").Clear
-Range("B49").Clear
-Range("C49").Clear
-Range("D49").Clear
-Range("A49").Value = "xlDBF3"
-Range("B49").Value = 8
-Range("C49").Value = num
-B49 = Range("B49").Value
-C49 = Range("C49").Value
-If B49 = C49 Then
-Range("D49").Value = "OK"
-Else
-Range("D49").Value = "NG"
-End If
-End Function
-
-Function test_xlDBF4(ByRef num)
-Range("A50").Clear
-Range("B50").Clear
-Range("C50").Clear
-Range("D50").Clear
-Range("A50").Value = "xlDBF4"
-Range("B50").Value = 11
-Range("C50").Value = num
-B50 = Range("B50").Value
-C50 = Range("C50").Value
-If B50 = C50 Then
-Range("D50").Value = "OK"
-Else
-Range("D50").Value = "NG"
-End If
-End Function
-
-Function test_xlDIF(ByRef num)
-Range("A51").Clear
-Range("B51").Clear
-Range("C51").Clear
-Range("D51").Clear
-Range("A51").Value = "xlDIF"
-Range("B51").Value = 9
-Range("C51").Value = num
-B51 = Range("B51").Value
-C51 = Range("C51").Value
-If B51 = C51 Then
-Range("D51").Value = "OK"
-Else
-Range("D51").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel2(ByRef num)
-Range("A52").Clear
-Range("B52").Clear
-Range("C52").Clear
-Range("D52").Clear
-Range("A52").Value = "xlExcel2"
-Range("B52").Value = 16
-Range("C52").Value = num
-B52 = Range("B52").Value
-C52 = Range("C52").Value
-If B52 = C52 Then
-Range("D52").Value = "OK"
-Else
-Range("D52").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel2FarEast(ByRef num)
-Range("A53").Clear
-Range("B53").Clear
-Range("C53").Clear
-Range("D53").Clear
-Range("A53").Value = "xlExcel2FarEast"
-Range("B53").Value = 27
-Range("C53").Value = num
-B53 = Range("B53").Value
-C53 = Range("C53").Value
-If B53 = C53 Then
-Range("D53").Value = "OK"
-Else
-Range("D53").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel3(ByRef num)
-Range("A54").Clear
-Range("B54").Clear
-Range("C54").Clear
-Range("D54").Clear
-Range("A54").Value = "xlExcel3"
-Range("B54").Value = 29
-Range("C54").Value = num
-B54 = Range("B54").Value
-C54 = Range("C54").Value
-If B54 = C54 Then
-Range("D54").Value = "OK"
-Else
-Range("D54").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel4(ByRef num)
-Range("A55").Clear
-Range("B55").Clear
-Range("C55").Clear
-Range("D55").Clear
-Range("A55").Value = "xlExcel4"
-Range("B55").Value = 33
-Range("C55").Value = num
-B55 = Range("B55").Value
-C55 = Range("C55").Value
-If B55 = C55 Then
-Range("D55").Value = "OK"
-Else
-Range("D55").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel4Wordbook(ByRef num)
-Range("A56").Clear
-Range("B56").Clear
-Range("C56").Clear
-Range("D56").Clear
-Range("A56").Value = "xlExcel4Wordbook"
-Range("B56").Value = 35
-Range("C56").Value = num
-B56 = Range("B56").Value
-C56 = Range("C56").Value
-If B56 = C56 Then
-Range("D56").Value = "OK"
-Else
-Range("D56").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel5(ByRef num)
-Range("A57").Clear
-Range("B57").Clear
-Range("C57").Clear
-Range("D57").Clear
-Range("A57").Value = "xlExcel5"
-Range("B57").Value = 39
-Range("C57").Value = num
-B57 = Range("B57").Value
-C57 = Range("C57").Value
-If B57 = C57 Then
-Range("D57").Value = "OK"
-Else
-Range("D57").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel7(ByRef num)
-Range("A58").Clear
-Range("B58").Clear
-Range("C58").Clear
-Range("D58").Clear
-Range("A58").Value = "xlExcel7"
-Range("B58").Value = 39
-Range("C58").Value = num
-B58 = Range("B58").Value
-C58 = Range("C58").Value
-If B58 = C58 Then
-Range("D58").Value = "OK"
-Else
-Range("D58").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel9795(ByRef num)
-Range("A59").Clear
-Range("B59").Clear
-Range("C59").Clear
-Range("D59").Clear
-Range("A59").Value = "xlExcel9795"
-Range("B59").Value = 43
-Range("C59").Value = num
-B59 = Range("B59").Value
-C59 = Range("C59").Value
-If B59 = C59 Then
-Range("D59").Value = "OK"
-Else
-Range("D59").Value = "NG"
-End If
-End Function
-
-Function test_xlHtml(ByRef num)
-Range("A60").Clear
-Range("B60").Clear
-Range("C60").Clear
-Range("D60").Clear
-Range("A60").Value = "xlHtml"
-Range("B60").Value = 44
-Range("C60").Value = num
-B60 = Range("B60").Value
-C60 = Range("C60").Value
-If B60 = C60 Then
-Range("D60").Value = "OK"
-Else
-Range("D60").Value = "NG"
-End If
-End Function
-
-Function test_xlIntlAddIn(ByRef num)
-Range("A61").Clear
-Range("B61").Clear
-Range("C61").Clear
-Range("D61").Clear
-Range("A61").Value = "xlIntlAddIn"
-Range("B61").Value = 26
-Range("C61").Value = num
-B61 = Range("B61").Value
-C61 = Range("C61").Value
-If B61 = C61 Then
-Range("D61").Value = "OK"
-Else
-Range("D61").Value = "NG"
-End If
-End Function
-
-Function test_xlIntlMacro(ByRef num)
-Range("A62").Clear
-Range("B62").Clear
-Range("C62").Clear
-Range("D62").Clear
-Range("A62").Value = "xlIntlMacro"
-Range("B62").Value = 25
-Range("C62").Value = num
-B62 = Range("B62").Value
-C62 = Range("C62").Value
-If B62 = C62 Then
-Range("D62").Value = "OK"
-Else
-Range("D62").Value = "NG"
-End If
-End Function
-
-Function test_xlSYLK(ByRef num)
-Range("A63").Clear
-Range("B63").Clear
-Range("C63").Clear
-Range("D63").Clear
-Range("A63").Value = "xlSYLK"
-Range("B63").Value = 2
-Range("C63").Value = num
-B63 = Range("B63").Value
-C63 = Range("C63").Value
-If B63 = C63 Then
-Range("D63").Value = "OK"
-Else
-Range("D63").Value = "NG"
-End If
-End Function
-
-Function test_xlTemplate(ByRef num)
-Range("A64").Clear
-Range("B64").Clear
-Range("C64").Clear
-Range("D64").Clear
-Range("A64").Value = "xlTemplate"
-Range("B64").Value = 17
-Range("C64").Value = num
-B64 = Range("B64").Value
-C64 = Range("C64").Value
-If B64 = C64 Then
-Range("D64").Value = "OK"
-Else
-Range("D64").Value = "NG"
-End If
-End Function
-
-Function test_xlTextMac(ByRef num)
-Range("A65").Clear
-Range("B65").Clear
-Range("C65").Clear
-Range("D65").Clear
-Range("A65").Value = "xlTextMac"
-Range("B65").Value = 19
-Range("C65").Value = num
-B65 = Range("B65").Value
-C65 = Range("C65").Value
-If B65 = C65 Then
-Range("D65").Value = "OK"
-Else
-Range("D65").Value = "NG"
-End If
-End Function
-
-Function test_xlTextMSDOS(ByRef num)
-Range("A66").Clear
-Range("B66").Clear
-Range("C66").Clear
-Range("D66").Clear
-Range("A66").Value = "xlTextMSDOS"
-Range("B66").Value = 21
-Range("C66").Value = num
-B66 = Range("B66").Value
-C66 = Range("C66").Value
-If B66 = C66 Then
-Range("D66").Value = "OK"
-Else
-Range("D66").Value = "NG"
-End If
-End Function
-
-Function test_xlTextPrinter(ByRef num)
-Range("A67").Clear
-Range("B67").Clear
-Range("C67").Clear
-Range("D67").Clear
-Range("A67").Value = "xlTextPrinter"
-Range("B67").Value = 36
-Range("C67").Value = num
-B67 = Range("B67").Value
-C67 = Range("C67").Value
-If B67 = C67 Then
-Range("D67").Value = "OK"
-Else
-Range("D67").Value = "NG"
-End If
-End Function
-
-Function test_xlTextWindows(ByRef num)
-Range("A68").Clear
-Range("B68").Clear
-Range("C68").Clear
-Range("D68").Clear
-Range("A68").Value = "xlTextWindows"
-Range("B68").Value = 20
-Range("C68").Value = num
-B68 = Range("B68").Value
-C68 = Range("C68").Value
-If B68 = C68 Then
-Range("D68").Value = "OK"
-Else
-Range("D68").Value = "NG"
-End If
-End Function
-
-Function test_xlUnicodeText(ByRef num)
-Range("A69").Clear
-Range("B69").Clear
-Range("C69").Clear
-Range("D69").Clear
-Range("A69").Value = "xlUnicodeText"
-Range("B69").Value = 42
-Range("C69").Value = num
-B69 = Range("B69").Value
-C69 = Range("C69").Value
-If B69 = C69 Then
-Range("D69").Value = "OK"
-Else
-Range("D69").Value = "NG"
-End If
-End Function
-
-Function test_xlWebArchive(ByRef num)
-Range("A70").Clear
-Range("B70").Clear
-Range("C70").Clear
-Range("D70").Clear
-Range("A70").Value = "xlWebArchive"
-Range("B70").Value = 45
-Range("C70").Value = num
-B70 = Range("B70").Value
-C70 = Range("C70").Value
-If B70 = C70 Then
-Range("D70").Value = "OK"
-Else
-Range("D70").Value = "NG"
-End If
-End Function
-
-Function test_xlWJ2WD1(ByRef num)
-Range("A71").Clear
-Range("B71").Clear
-Range("C71").Clear
-Range("D71").Clear
-Range("A71").Value = "xlWJ2WD1"
-Range("B71").Value = 14
-Range("C71").Value = num
-B71 = Range("B71").Value
-C71 = Range("C71").Value
-If B71 = C71 Then
-Range("D71").Value = "OK"
-Else
-Range("D71").Value = "NG"
-End If
-End Function
-
-Function test_xlWJ3(ByRef num)
-Range("A72").Clear
-Range("B72").Clear
-Range("C72").Clear
-Range("D72").Clear
-Range("A72").Value = "xlWJ3"
-Range("B72").Value = 40
-Range("C72").Value = num
-B72 = Range("B72").Value
-C72 = Range("C72").Value
-If B72 = C72 Then
-Range("D72").Value = "OK"
-Else
-Range("D72").Value = "NG"
-End If
-End Function
-
-Function test_xlWJ3FJ3(ByRef num)
-Range("A73").Clear
-Range("B73").Clear
-Range("C73").Clear
-Range("D73").Clear
-Range("A73").Value = "xlWJ3FJ3"
-Range("B73").Value = 41
-Range("C73").Value = num
-B73 = Range("B73").Value
-C73 = Range("C73").Value
-If B73 = C73 Then
-Range("D73").Value = "OK"
-Else
-Range("D73").Value = "NG"
-End If
-End Function
-
-Function test_xlWK1(ByRef num)
-Range("A74").Clear
-Range("B74").Clear
-Range("C74").Clear
-Range("D74").Clear
-Range("A74").Value = "xlWK1"
-Range("B74").Value = 5
-Range("C74").Value = num
-B74 = Range("B74").Value
-C74 = Range("C74").Value
-If B74 = C74 Then
-Range("D74").Value = "OK"
-Else
-Range("D74").Value = "NG"
-End If
-End Function
-
-Function test_xlWK1ALL(ByRef num)
-Range("A75").Clear
-Range("B75").Clear
-Range("C75").Clear
-Range("D75").Clear
-Range("A75").Value = "xlWK1ALL"
-Range("B75").Value = 31
-Range("C75").Value = num
-B75 = Range("B75").Value
-C75 = Range("C75").Value
-If B75 = C75 Then
-Range("D75").Value = "OK"
-Else
-Range("D75").Value = "NG"
-End If
-End Function
-
-Function test_xlWK1FMT(ByRef num)
-Range("A76").Clear
-Range("B76").Clear
-Range("C76").Clear
-Range("D76").Clear
-Range("A76").Value = "xlWK1FMT"
-Range("B76").Value = 30
-Range("C76").Value = num
-B76 = Range("B76").Value
-C76 = Range("C76").Value
-If B76 = C76 Then
-Range("D76").Value = "OK"
-Else
-Range("D76").Value = "NG"
-End If
-End Function
-
-Function test_xlWK3(ByRef num)
-Range("A77").Clear
-Range("B77").Clear
-Range("C77").Clear
-Range("D77").Clear
-Range("A77").Value = "xlWK3"
-Range("B77").Value = 15
-Range("C77").Value = num
-B77 = Range("B77").Value
-C77 = Range("C77").Value
-If B77 = C77 Then
-Range("D77").Value = "OK"
-Else
-Range("D77").Value = "NG"
-End If
-End Function
-
-Function test_xlWK3FM3(ByRef num)
-Range("A78").Clear
-Range("B78").Clear
-Range("C78").Clear
-Range("D78").Clear
-Range("A78").Value = "xlWK3FM3"
-Range("B78").Value = 32
-Range("C78").Value = num
-B78 = Range("B78").Value
-C78 = Range("C78").Value
-If B78 = C78 Then
-Range("D78").Value = "OK"
-Else
-Range("D78").Value = "NG"
-End If
-End Function
-
-Function test_xlWK4(ByRef num)
-Range("A79").Clear
-Range("B79").Clear
-Range("C79").Clear
-Range("D79").Clear
-Range("A79").Value = "xlWK4"
-Range("B79").Value = 38
-Range("C79").Value = num
-B79 = Range("B79").Value
-C79 = Range("C79").Value
-If B79 = C79 Then
-Range("D79").Value = "OK"
-Else
-Range("D79").Value = "NG"
-End If
-End Function
-
-Function test_xlWKS(ByRef num)
-Range("A80").Clear
-Range("B80").Clear
-Range("C80").Clear
-Range("D80").Clear
-Range("A80").Value = "xlWKS"
-Range("B80").Value = 4
-Range("C80").Value = num
-B80 = Range("B80").Value
-C80 = Range("C80").Value
-If B80 = C80 Then
-Range("D80").Value = "OK"
-Else
-Range("D80").Value = "NG"
-End If
-End Function
-
-Function test_xlWordbookNormal(ByRef num)
-Range("A81").Clear
-Range("B81").Clear
-Range("C81").Clear
-Range("D81").Clear
-Range("A81").Value = "xlWordbookNormal"
-Range("B81").Value = -4143
-Range("C81").Value = num
-B81 = Range("B81").Value
-C81 = Range("C81").Value
-If B81 = C81 Then
-Range("D81").Value = "OK"
-Else
-Range("D81").Value = "NG"
-End If
-End Function
-
-Function test_xlWords2FarEast(ByRef num)
-Range("A82").Clear
-Range("B82").Clear
-Range("C82").Clear
-Range("D82").Clear
-Range("A82").Value = "xlWords2FarEast"
-Range("B82").Value = 28
-Range("C82").Value = num
-B82 = Range("B82").Value
-C82 = Range("C82").Value
-If B82 = C82 Then
-Range("D82").Value = "OK"
-Else
-Range("D82").Value = "NG"
-End If
-End Function
-
-Function test_xlWQ1(ByRef num)
-Range("A83").Clear
-Range("B83").Clear
-Range("C83").Clear
-Range("D83").Clear
-Range("A83").Value = "xlWQ1"
-Range("B83").Value = 34
-Range("C83").Value = num
-B83 = Range("B83").Value
-C83 = Range("C83").Value
-If B83 = C83 Then
-Range("D83").Value = "OK"
-Else
-Range("D83").Value = "NG"
-End If
-End Function
-
-Function test_xlXMLSpredsheet(ByRef num)
-Range("A84").Clear
-Range("B84").Clear
-Range("C84").Clear
-Range("D84").Clear
-Range("A84").Value = "xlXMLSpredsheet"
-Range("B84").Value = 46
-Range("C84").Value = num
-B84 = Range("B84").Value
-C84 = Range("C84").Value
-If B84 = C84 Then
-Range("D84").Value = "OK"
-Else
-Range("D84").Value = "NG"
-End If
-End Function
-
-Function test_xlFillWithAll(ByRef num)
-Range("A85").Clear
-Range("B85").Clear
-Range("C85").Clear
-Range("D85").Clear
-Range("A85").Value = "xlFillWithAll"
-Range("B85").Value = -4104
-Range("C85").Value = num
-B85 = Range("B85").Value
-C85 = Range("C85").Value
-If B85 = C85 Then
-Range("D85").Value = "OK"
-Else
-Range("D85").Value = "NG"
-End If
-End Function
-
-Function test_xlFillWithContents(ByRef num)
-Range("A86").Clear
-Range("B86").Clear
-Range("C86").Clear
-Range("D86").Clear
-Range("A86").Value = "xlFillWithContents"
-Range("B86").Value = 2
-Range("C86").Value = num
-B86 = Range("B86").Value
-C86 = Range("C86").Value
-If B86 = C86 Then
-Range("D86").Value = "OK"
-Else
-Range("D86").Value = "NG"
-End If
-End Function
-
-Function test_xlFillWithFormats(ByRef num)
-Range("A87").Clear
-Range("B87").Clear
-Range("C87").Clear
-Range("D87").Clear
-Range("A87").Value = "xlFillWithFormats"
-Range("B87").Value = -4122
-Range("C87").Value = num
-B87 = Range("B87").Value
-C87 = Range("C87").Value
-If B87 = C87 Then
-Range("D87").Value = "OK"
-Else
-Range("D87").Value = "NG"
-End If
-End Function
-
-Function test_xlFilterCopy(ByRef num)
-Range("A88").Clear
-Range("B88").Clear
-Range("C88").Clear
-Range("D88").Clear
-Range("A88").Value = "xlFilterCopy"
-Range("B88").Value = 2
-Range("C88").Value = num
-B88 = Range("B88").Value
-C88 = Range("C88").Value
-If B88 = C88 Then
-Range("D88").Value = "OK"
-Else
-Range("D88").Value = "NG"
-End If
-End Function
-
-Function test_xlFilterInPlace(ByRef num)
-Range("A89").Clear
-Range("B89").Clear
-Range("C89").Clear
-Range("D89").Clear
-Range("A89").Value = "xlFilterInPlace"
-Range("B89").Value = 1
-Range("C89").Value = num
-B89 = Range("B89").Value
-C89 = Range("C89").Value
-If B89 = C89 Then
-Range("D89").Value = "OK"
-Else
-Range("D89").Value = "NG"
-End If
-End Function
-
-Function test_xlComments(ByRef num)
-Range("A90").Clear
-Range("B90").Clear
-Range("C90").Clear
-Range("D90").Clear
-Range("A90").Value = "xlComments"
-Range("B90").Value = -4144
-Range("C90").Value = num
-B90 = Range("B90").Value
-C90 = Range("C90").Value
-If B90 = C90 Then
-Range("D90").Value = "OK"
-Else
-Range("D90").Value = "NG"
-End If
-End Function
-
-Function test_xlFormulas(ByRef num)
-Range("A91").Clear
-Range("B91").Clear
-Range("C91").Clear
-Range("D91").Clear
-Range("A91").Value = "xlFormulas"
-Range("B91").Value = -4123
-Range("C91").Value = num
-B91 = Range("B91").Value
-C91 = Range("C91").Value
-If B91 = C91 Then
-Range("D91").Value = "OK"
-Else
-Range("D91").Value = "NG"
-End If
-End Function
-
-Function test_xlValues(ByRef num)
-Range("A92").Clear
-Range("B92").Clear
-Range("C92").Clear
-Range("D92").Clear
-Range("A92").Value = "xlValues"
-Range("B92").Value = -4163
-Range("C92").Value = num
-B92 = Range("B92").Value
-C92 = Range("C92").Value
-If B92 = C92 Then
-Range("D92").Value = "OK"
-Else
-Range("D92").Value = "NG"
-End If
-End Function
-
-Function test_xlButtonControl(ByRef num)
-Range("A93").Clear
-Range("B93").Clear
-Range("C93").Clear
-Range("D93").Clear
-Range("A93").Value = "xlButtonControl"
-Range("B93").Value = 0
-Range("C93").Value = num
-B93 = Range("B93").Value
-C93 = Range("C93").Value
-If B93 = C93 Then
-Range("D93").Value = "OK"
-Else
-Range("D93").Value = "NG"
-End If
-End Function
-
-Function test_xlCheckBox(ByRef num)
-Range("A94").Clear
-Range("B94").Clear
-Range("C94").Clear
-Range("D94").Clear
-Range("A94").Value = "xlCheckBox"
-Range("B94").Value = 1
-Range("C94").Value = num
-B94 = Range("B94").Value
-C94 = Range("C94").Value
-If B94 = C94 Then
-Range("D94").Value = "OK"
-Else
-Range("D94").Value = "NG"
-End If
-End Function
-
-Function test_xlDropDown(ByRef num)
-Range("A95").Clear
-Range("B95").Clear
-Range("C95").Clear
-Range("D95").Clear
-Range("A95").Value = "xlDropDown"
-Range("B95").Value = 2
-Range("C95").Value = num
-B95 = Range("B95").Value
-C95 = Range("C95").Value
-If B95 = C95 Then
-Range("D95").Value = "OK"
-Else
-Range("D95").Value = "NG"
-End If
-End Function
-
-Function test_xlEditBox(ByRef num)
-Range("A96").Clear
-Range("B96").Clear
-Range("C96").Clear
-Range("D96").Clear
-Range("A96").Value = "xlEditBox"
-Range("B96").Value = 3
-Range("C96").Value = num
-B96 = Range("B96").Value
-C96 = Range("C96").Value
-If B96 = C96 Then
-Range("D96").Value = "OK"
-Else
-Range("D96").Value = "NG"
-End If
-End Function
-
-Function test_xlGroupBox(ByRef num)
-Range("A97").Clear
-Range("B97").Clear
-Range("C97").Clear
-Range("D97").Clear
-Range("A97").Value = "xlGroupBox"
-Range("B97").Value = 4
-Range("C97").Value = num
-B97 = Range("B97").Value
-C97 = Range("C97").Value
-If B97 = C97 Then
-Range("D97").Value = "OK"
-Else
-Range("D97").Value = "NG"
-End If
-End Function
-
-Function test_xlLabel(ByRef num)
-Range("A98").Clear
-Range("B98").Clear
-Range("C98").Clear
-Range("D98").Clear
-Range("A98").Value = "xlLabel"
-Range("B98").Value = 5
-Range("C98").Value = num
-B98 = Range("B98").Value
-C98 = Range("C98").Value
-If B98 = C98 Then
-Range("D98").Value = "OK"
-Else
-Range("D98").Value = "NG"
-End If
-End Function
-
-Function test_xlListBox(ByRef num)
-Range("A99").Clear
-Range("B99").Clear
-Range("C99").Clear
-Range("D99").Clear
-Range("A99").Value = "xlListBox"
-Range("B99").Value = 6
-Range("C99").Value = num
-B99 = Range("B99").Value
-C99 = Range("C99").Value
-If B99 = C99 Then
-Range("D99").Value = "OK"
-Else
-Range("D99").Value = "NG"
-End If
-End Function
-
-Function test_xlOptionButton(ByRef num)
-Range("A100").Clear
-Range("B100").Clear
-Range("C100").Clear
-Range("D100").Clear
-Range("A100").Value = "xlOptionButton"
-Range("B100").Value = 7
-Range("C100").Value = num
-B100 = Range("B100").Value
-C100 = Range("C100").Value
-If B100 = C100 Then
-Range("D100").Value = "OK"
-Else
-Range("D100").Value = "NG"
-End If
-End Function
-
-Function test_xlSchollBar(ByRef num)
-Range("A101").Clear
-Range("B101").Clear
-Range("C101").Clear
-Range("D101").Clear
-Range("A101").Value = "xlSchollBar"
-Range("B101").Value = 8
-Range("C101").Value = num
-B101 = Range("B101").Value
-C101 = Range("C101").Value
-If B101 = C101 Then
-Range("D101").Value = "OK"
-Else
-Range("D101").Value = "NG"
-End If
-End Function
-
-Function test_xlSpinner(ByRef num)
-Range("A102").Clear
-Range("B102").Clear
-Range("C102").Clear
-Range("D102").Clear
-Range("A102").Value = "xlSpinner"
-Range("B102").Value = 9
-Range("C102").Value = num
-B102 = Range("B102").Value
-C102 = Range("C102").Value
-If B102 = C102 Then
-Range("D102").Value = "OK"
-Else
-Range("D102").Value = "NG"
-End If
-End Function
-
-Function test_xlBetween(ByRef num)
-Range("A103").Clear
-Range("B103").Clear
-Range("C103").Clear
-Range("D103").Clear
-Range("A103").Value = "xlBetween"
-Range("B103").Value = 1
-Range("C103").Value = num
-B103 = Range("B103").Value
-C103 = Range("C103").Value
-If B103 = C103 Then
-Range("D103").Value = "OK"
-Else
-Range("D103").Value = "NG"
-End If
-End Function
-
-Function test_xlEqual(ByRef num)
-Range("A104").Clear
-Range("B104").Clear
-Range("C104").Clear
-Range("D104").Clear
-Range("A104").Value = "xlEqual"
-Range("B104").Value = 3
-Range("C104").Value = num
-B104 = Range("B104").Value
-C104 = Range("C104").Value
-If B104 = C104 Then
-Range("D104").Value = "OK"
-Else
-Range("D104").Value = "NG"
-End If
-End Function
-
-Function test_xlGreater(ByRef num)
-Range("A105").Clear
-Range("B105").Clear
-Range("C105").Clear
-Range("D105").Clear
-Range("A105").Value = "xlGreater"
-Range("B105").Value = 5
-Range("C105").Value = num
-B105 = Range("B105").Value
-C105 = Range("C105").Value
-If B105 = C105 Then
-Range("D105").Value = "OK"
-Else
-Range("D105").Value = "NG"
-End If
-End Function
-
-Function test_xlGreaterEqual(ByRef num)
-Range("A106").Clear
-Range("B106").Clear
-Range("C106").Clear
-Range("D106").Clear
-Range("A106").Value = "xlGreaterEqual"
-Range("B106").Value = 7
-Range("C106").Value = num
-B106 = Range("B106").Value
-C106 = Range("C106").Value
-If B106 = C106 Then
-Range("D106").Value = "OK"
-Else
-Range("D106").Value = "NG"
-End If
-End Function
-
-Function test_xlLess(ByRef num)
-Range("A107").Clear
-Range("B107").Clear
-Range("C107").Clear
-Range("D107").Clear
-Range("A107").Value = "xlLess"
-Range("B107").Value = 6
-Range("C107").Value = num
-B107 = Range("B107").Value
-C107 = Range("C107").Value
-If B107 = C107 Then
-Range("D107").Value = "OK"
-Else
-Range("D107").Value = "NG"
-End If
-End Function
-
-Function test_xlLessEqual(ByRef num)
-Range("A108").Clear
-Range("B108").Clear
-Range("C108").Clear
-Range("D108").Clear
-Range("A108").Value = "xlLessEqual"
-Range("B108").Value = 8
-Range("C108").Value = num
-B108 = Range("B108").Value
-C108 = Range("C108").Value
-If B108 = C108 Then
-Range("D108").Value = "OK"
-Else
-Range("D108").Value = "NG"
-End If
-End Function
-
-Function test_xlNotBetween(ByRef num)
-Range("A109").Clear
-Range("B109").Clear
-Range("C109").Clear
-Range("D109").Clear
-Range("A109").Value = "xlNotBetween"
-Range("B109").Value = 2
-Range("C109").Value = num
-B109 = Range("B109").Value
-C109 = Range("C109").Value
-If B109 = C109 Then
-Range("D109").Value = "OK"
-Else
-Range("D109").Value = "NG"
-End If
-End Function
-
-Function test_xlNotEqual(ByRef num)
-Range("A110").Clear
-Range("B110").Clear
-Range("C110").Clear
-Range("D110").Clear
-Range("A110").Value = "xlNotEqual"
-Range("B110").Value = 4
-Range("C110").Value = num
-B110 = Range("B110").Value
-C110 = Range("C110").Value
-If B110 = C110 Then
-Range("D110").Value = "OK"
-Else
-Range("D110").Value = "NG"
-End If
-End Function
-
-Function test_xlCellValue(ByRef num)
-Range("A111").Clear
-Range("B111").Clear
-Range("C111").Clear
-Range("D111").Clear
-Range("A111").Value = "xlCellValue"
-Range("B111").Value = 1
-Range("C111").Value = num
-B111 = Range("B111").Value
-C111 = Range("C111").Value
-If B111 = C111 Then
-Range("D111").Value = "OK"
-Else
-Range("D111").Value = "NG"
-End If
-End Function
-
-Function test_xlExpression(ByRef num)
-Range("A112").Clear
-Range("B112").Clear
-Range("C112").Clear
-Range("D112").Clear
-Range("A112").Value = "xlExpression"
-Range("B112").Value = 2
-Range("C112").Value = num
-B112 = Range("B112").Value
-C112 = Range("C112").Value
-If B112 = C112 Then
-Range("D112").Value = "OK"
-Else
-Range("D112").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnLabels(ByRef num)
-Range("A113").Clear
-Range("B113").Clear
-Range("C113").Clear
-Range("D113").Clear
-Range("A113").Value = "xlColumnLabels"
-Range("B113").Value = 2
-Range("C113").Value = num
-B113 = Range("B113").Value
-C113 = Range("C113").Value
-If B113 = C113 Then
-Range("D113").Value = "OK"
-Else
-Range("D113").Value = "NG"
-End If
-End Function
-
-Function test_xlMixedLabels(ByRef num)
-Range("A114").Clear
-Range("B114").Clear
-Range("C114").Clear
-Range("D114").Clear
-Range("A114").Value = "xlMixedLabels"
-Range("B114").Value = 3
-Range("C114").Value = num
-B114 = Range("B114").Value
-C114 = Range("C114").Value
-If B114 = C114 Then
-Range("D114").Value = "OK"
-Else
-Range("D114").Value = "NG"
-End If
-End Function
-
-Function test_xlNoLabels(ByRef num)
-Range("A115").Clear
-Range("B115").Clear
-Range("C115").Clear
-Range("D115").Clear
-Range("A115").Value = "xlNoLabels"
-Range("B115").Value = -4142
-Range("C115").Value = num
-B115 = Range("B115").Value
-C115 = Range("C115").Value
-If B115 = C115 Then
-Range("D115").Value = "OK"
-Else
-Range("D115").Value = "NG"
-End If
-End Function
-
-Function test_xlRowLabels(ByRef num)
-Range("A116").Clear
-Range("B116").Clear
-Range("C116").Clear
-Range("D116").Clear
-Range("A116").Value = "xlRowLabels"
-Range("B116").Value = 1
-Range("C116").Value = num
-B116 = Range("B116").Value
-C116 = Range("C116").Value
-If B116 = C116 Then
-Range("D116").Value = "OK"
-Else
-Range("D116").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignCenter(ByRef num)
-Range("A117").Clear
-Range("B117").Clear
-Range("C117").Clear
-Range("D117").Clear
-Range("A117").Value = "xlHAlignCenter"
-Range("B117").Value = -4108
-Range("C117").Value = num
-B117 = Range("B117").Value
-C117 = Range("C117").Value
-If B117 = C117 Then
-Range("D117").Value = "OK"
-Else
-Range("D117").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignCenterAcrossSelection(ByRef num)
-Range("A118").Clear
-Range("B118").Clear
-Range("C118").Clear
-Range("D118").Clear
-Range("A118").Value = "xlHAlignCenterAcrossSelection"
-Range("B118").Value = 7
-Range("C118").Value = num
-B118 = Range("B118").Value
-C118 = Range("C118").Value
-If B118 = C118 Then
-Range("D118").Value = "OK"
-Else
-Range("D118").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignDistributed(ByRef num)
-Range("A119").Clear
-Range("B119").Clear
-Range("C119").Clear
-Range("D119").Clear
-Range("A119").Value = "xlHAlignDistributed"
-Range("B119").Value = -4117
-Range("C119").Value = num
-B119 = Range("B119").Value
-C119 = Range("C119").Value
-If B119 = C119 Then
-Range("D119").Value = "OK"
-Else
-Range("D119").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignFull(ByRef num)
-Range("A120").Clear
-Range("B120").Clear
-Range("C120").Clear
-Range("D120").Clear
-Range("A120").Value = "xlHAlignFull"
-Range("B120").Value = 5
-Range("C120").Value = num
-B120 = Range("B120").Value
-C120 = Range("C120").Value
-If B120 = C120 Then
-Range("D120").Value = "OK"
-Else
-Range("D120").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignGeneral(ByRef num)
-Range("A121").Clear
-Range("B121").Clear
-Range("C121").Clear
-Range("D121").Clear
-Range("A121").Value = "xlHAlignGeneral"
-Range("B121").Value = 1
-Range("C121").Value = num
-B121 = Range("B121").Value
-C121 = Range("C121").Value
-If B121 = C121 Then
-Range("D121").Value = "OK"
-Else
-Range("D121").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignJustify(ByRef num)
-Range("A122").Clear
-Range("B122").Clear
-Range("C122").Clear
-Range("D122").Clear
-Range("A122").Value = "xlHAlignJustify"
-Range("B122").Value = -4130
-Range("C122").Value = num
-B122 = Range("B122").Value
-C122 = Range("C122").Value
-If B122 = C122 Then
-Range("D122").Value = "OK"
-Else
-Range("D122").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignLeft(ByRef num)
-Range("A123").Clear
-Range("B123").Clear
-Range("C123").Clear
-Range("D123").Clear
-Range("A123").Value = "xlHAlignLeft"
-Range("B123").Value = -4131
-Range("C123").Value = num
-B123 = Range("B123").Value
-C123 = Range("C123").Value
-If B123 = C123 Then
-Range("D123").Value = "OK"
-Else
-Range("D123").Value = "NG"
-End If
-End Function
-
-Function test_xlHAlignRight(ByRef num)
-Range("A124").Clear
-Range("B124").Clear
-Range("C124").Clear
-Range("D124").Clear
-Range("A124").Value = "xlHAlignRight"
-Range("B124").Value = -4152
-Range("C124").Value = num
-B124 = Range("B124").Value
-C124 = Range("C124").Value
-If B124 = C124 Then
-Range("D124").Value = "OK"
-Else
-Range("D124").Value = "NG"
-End If
-End Function
-
-Function test_xlHebrewFullScript(ByRef num)
-Range("A125").Clear
-Range("B125").Clear
-Range("C125").Clear
-Range("D125").Clear
-Range("A125").Value = "xlHebrewFullScript"
-Range("B125").Value = 0
-Range("C125").Value = num
-B125 = Range("B125").Value
-C125 = Range("C125").Value
-If B125 = C125 Then
-Range("D125").Value = "OK"
-Else
-Range("D125").Value = "NG"
-End If
-End Function
-
-Function test_xlHebrewMixedAuthorizedScript(ByRef num)
-Range("A126").Clear
-Range("B126").Clear
-Range("C126").Clear
-Range("D126").Clear
-Range("A126").Value = "xlHebrewMixedAuthorizedScript"
-Range("B126").Value = 3
-Range("C126").Value = num
-B126 = Range("B126").Value
-C126 = Range("C126").Value
-If B126 = C126 Then
-Range("D126").Value = "OK"
-Else
-Range("D126").Value = "NG"
-End If
-End Function
-
-Function test_xlHebrewMixedScript(ByRef num)
-Range("A127").Clear
-Range("B127").Clear
-Range("C127").Clear
-Range("D127").Clear
-Range("A127").Value = "xlHebrewMixedScript"
-Range("B127").Value = 2
-Range("C127").Value = num
-B127 = Range("B127").Value
-C127 = Range("C127").Value
-If B127 = C127 Then
-Range("D127").Value = "OK"
-Else
-Range("D127").Value = "NG"
-End If
-End Function
-
-Function test_xlHebrewPartialScript(ByRef num)
-Range("A128").Clear
-Range("B128").Clear
-Range("C128").Clear
-Range("D128").Clear
-Range("A128").Value = "xlHebrewPartialScript"
-Range("B128").Value = 1
-Range("C128").Value = num
-B128 = Range("B128").Value
-C128 = Range("C128").Value
-If B128 = C128 Then
-Range("D128").Value = "OK"
-Else
-Range("D128").Value = "NG"
-End If
-End Function
-
-Function test_xlAllChanges(ByRef num)
-Range("A129").Clear
-Range("B129").Clear
-Range("C129").Clear
-Range("D129").Clear
-Range("A129").Value = "xlAllChanges"
-Range("B129").Value = 2
-Range("C129").Value = num
-B129 = Range("B129").Value
-C129 = Range("C129").Value
-If B129 = C129 Then
-Range("D129").Value = "OK"
-Else
-Range("D129").Value = "NG"
-End If
-End Function
-
-Function test_xlNotYetReviewed(ByRef num)
-Range("A130").Clear
-Range("B130").Clear
-Range("C130").Clear
-Range("D130").Clear
-Range("A130").Value = "xlNotYetReviewed"
-Range("B130").Value = 3
-Range("C130").Value = num
-B130 = Range("B130").Value
-C130 = Range("C130").Value
-If B130 = C130 Then
-Range("D130").Value = "OK"
-Else
-Range("D130").Value = "NG"
-End If
-End Function
-
-Function test_xlSinceMyLastSave(ByRef num)
-Range("A131").Clear
-Range("B131").Clear
-Range("C131").Clear
-Range("D131").Clear
-Range("A131").Value = "xlSinceMyLastSave"
-Range("B131").Value = 1
-Range("C131").Value = num
-B131 = Range("B131").Value
-C131 = Range("C131").Value
-If B131 = C131 Then
-Range("D131").Value = "OK"
-Else
-Range("D131").Value = "NG"
-End If
-End Function
-
-Function test_xlHtmlCalc(ByRef num)
-Range("A132").Clear
-Range("B132").Clear
-Range("C132").Clear
-Range("D132").Clear
-Range("A132").Value = "xlHtmlCalc"
-Range("B132").Value = 1
-Range("C132").Value = num
-B132 = Range("B132").Value
-C132 = Range("C132").Value
-If B132 = C132 Then
-Range("D132").Value = "OK"
-Else
-Range("D132").Value = "NG"
-End If
-End Function
-
-Function test_xlHtmlChart(ByRef num)
-Range("A133").Clear
-Range("B133").Clear
-Range("C133").Clear
-Range("D133").Clear
-Range("A133").Value = "xlHtmlChart"
-Range("B133").Value = 3
-Range("C133").Value = num
-B133 = Range("B133").Value
-C133 = Range("C133").Value
-If B133 = C133 Then
-Range("D133").Value = "OK"
-Else
-Range("D133").Value = "NG"
-End If
-End Function
-
-Function test_xlHtmlList(ByRef num)
-Range("A134").Clear
-Range("B134").Clear
-Range("C134").Clear
-Range("D134").Clear
-Range("A134").Value = "xlHtmlList"
-Range("B134").Value = 2
-Range("C134").Value = num
-B134 = Range("B134").Value
-C134 = Range("C134").Value
-If B134 = C134 Then
-Range("D134").Value = "OK"
-Else
-Range("D134").Value = "NG"
-End If
-End Function
-
-Function test_xlHtmlStatic(ByRef num)
-Range("A135").Clear
-Range("B135").Clear
-Range("C135").Clear
-Range("D135").Clear
-Range("A135").Value = "xlHtmlStatic"
-Range("B135").Value = 0
-Range("C135").Value = num
-B135 = Range("B135").Value
-C135 = Range("C135").Value
-If B135 = C135 Then
-Range("D135").Value = "OK"
-Else
-Range("D135").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeAlpha(ByRef num)
-Range("A136").Clear
-Range("B136").Clear
-Range("C136").Clear
-Range("D136").Clear
-Range("A136").Value = "xlIMEModeAlpha"
-Range("B136").Value = 8
-Range("C136").Value = num
-B136 = Range("B136").Value
-C136 = Range("C136").Value
-If B136 = C136 Then
-Range("D136").Value = "OK"
-Else
-Range("D136").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeAlphaFull(ByRef num)
-Range("A137").Clear
-Range("B137").Clear
-Range("C137").Clear
-Range("D137").Clear
-Range("A137").Value = "xlIMEModeAlphaFull"
-Range("B137").Value = 7
-Range("C137").Value = num
-B137 = Range("B137").Value
-C137 = Range("C137").Value
-If B137 = C137 Then
-Range("D137").Value = "OK"
-Else
-Range("D137").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeDisable(ByRef num)
-Range("A138").Clear
-Range("B138").Clear
-Range("C138").Clear
-Range("D138").Clear
-Range("A138").Value = "xlIMEModeDisable"
-Range("B138").Value = 3
-Range("C138").Value = num
-B138 = Range("B138").Value
-C138 = Range("C138").Value
-If B138 = C138 Then
-Range("D138").Value = "OK"
-Else
-Range("D138").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeHangul(ByRef num)
-Range("A139").Clear
-Range("B139").Clear
-Range("C139").Clear
-Range("D139").Clear
-Range("A139").Value = "xlIMEModeHangul"
-Range("B139").Value = 10
-Range("C139").Value = num
-B139 = Range("B139").Value
-C139 = Range("C139").Value
-If B139 = C139 Then
-Range("D139").Value = "OK"
-Else
-Range("D139").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeHangulFull(ByRef num)
-Range("A140").Clear
-Range("B140").Clear
-Range("C140").Clear
-Range("D140").Clear
-Range("A140").Value = "xlIMEModeHangulFull"
-Range("B140").Value = 9
-Range("C140").Value = num
-B140 = Range("B140").Value
-C140 = Range("C140").Value
-If B140 = C140 Then
-Range("D140").Value = "OK"
-Else
-Range("D140").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeHiragana(ByRef num)
-Range("A141").Clear
-Range("B141").Clear
-Range("C141").Clear
-Range("D141").Clear
-Range("A141").Value = "xlIMEModeHiragana"
-Range("B141").Value = 4
-Range("C141").Value = num
-B141 = Range("B141").Value
-C141 = Range("C141").Value
-If B141 = C141 Then
-Range("D141").Value = "OK"
-Else
-Range("D141").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeKatakana(ByRef num)
-Range("A142").Clear
-Range("B142").Clear
-Range("C142").Clear
-Range("D142").Clear
-Range("A142").Value = "xlIMEModeKatakana"
-Range("B142").Value = 5
-Range("C142").Value = num
-B142 = Range("B142").Value
-C142 = Range("C142").Value
-If B142 = C142 Then
-Range("D142").Value = "OK"
-Else
-Range("D142").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeKatakanaHalf(ByRef num)
-Range("A143").Clear
-Range("B143").Clear
-Range("C143").Clear
-Range("D143").Clear
-Range("A143").Value = "xlIMEModeKatakanaHalf"
-Range("B143").Value = 6
-Range("C143").Value = num
-B143 = Range("B143").Value
-C143 = Range("C143").Value
-If B143 = C143 Then
-Range("D143").Value = "OK"
-Else
-Range("D143").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeNoControl(ByRef num)
-Range("A144").Clear
-Range("B144").Clear
-Range("C144").Clear
-Range("D144").Clear
-Range("A144").Value = "xlIMEModeNoControl"
-Range("B144").Value = 0
-Range("C144").Value = num
-B144 = Range("B144").Value
-C144 = Range("C144").Value
-If B144 = C144 Then
-Range("D144").Value = "OK"
-Else
-Range("D144").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeOff(ByRef num)
-Range("A145").Clear
-Range("B145").Clear
-Range("C145").Clear
-Range("D145").Clear
-Range("A145").Value = "xlIMEModeOff"
-Range("B145").Value = 2
-Range("C145").Value = num
-B145 = Range("B145").Value
-C145 = Range("C145").Value
-If B145 = C145 Then
-Range("D145").Value = "OK"
-Else
-Range("D145").Value = "NG"
-End If
-End Function
-
-Function test_xlIMEModeOn(ByRef num)
-Range("A146").Clear
-Range("B146").Clear
-Range("C146").Clear
-Range("D146").Clear
-Range("A146").Value = "xlIMEModeOn"
-Range("B146").Value = 1
-Range("C146").Value = num
-B146 = Range("B146").Value
-C146 = Range("C146").Value
-If B146 = C146 Then
-Range("D146").Value = "OK"
-Else
-Range("D146").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotTableReport(ByRef num)
-Range("A147").Clear
-Range("B147").Clear
-Range("C147").Clear
-Range("D147").Clear
-Range("A147").Value = "xlPivotTableReport"
-Range("B147").Value = 1
-Range("C147").Value = num
-B147 = Range("B147").Value
-C147 = Range("C147").Value
-If B147 = C147 Then
-Range("D147").Value = "OK"
-Else
-Range("D147").Value = "NG"
-End If
-End Function
-
-Function test_xlQueryTable(ByRef num)
-Range("A148").Clear
-Range("B148").Clear
-Range("C148").Clear
-Range("D148").Clear
-Range("A148").Value = "xlQueryTable"
-Range("B148").Value = 0
-Range("C148").Value = num
-B148 = Range("B148").Value
-C148 = Range("C148").Value
-If B148 = C148 Then
-Range("D148").Value = "OK"
-Else
-Range("D148").Value = "NG"
-End If
-End Function
-
-Function test_xlFormatFromLeftOrAbove(ByRef num)
-Range("A149").Clear
-Range("B149").Clear
-Range("C149").Clear
-Range("D149").Clear
-Range("A149").Value = "xlFormatFromLeftOrAbove"
-Range("B149").Value = 0
-Range("C149").Value = num
-B149 = Range("B149").Value
-C149 = Range("C149").Value
-If B149 = C149 Then
-Range("D149").Value = "OK"
-Else
-Range("D149").Value = "NG"
-End If
-End Function
-
-Function test_xlFormatFromRightOrAbove(ByRef num)
-Range("A150").Clear
-Range("B150").Clear
-Range("C150").Clear
-Range("D150").Clear
-Range("A150").Value = "xlFormatFromRightOrAbove"
-Range("B150").Value = 1
-Range("C150").Value = num
-B150 = Range("B150").Value
-C150 = Range("C150").Value
-If B150 = C150 Then
-Range("D150").Value = "OK"
-Else
-Range("D150").Value = "NG"
-End If
-End Function
-
-Function test_xlShiftDown(ByRef num)
-Range("A151").Clear
-Range("B151").Clear
-Range("C151").Clear
-Range("D151").Clear
-Range("A151").Value = "xlShiftDown"
-Range("B151").Value = -4121
-Range("C151").Value = num
-B151 = Range("B151").Value
-C151 = Range("C151").Value
-If B151 = C151 Then
-Range("D151").Value = "OK"
-Else
-Range("D151").Value = "NG"
-End If
-End Function
-
-Function test_xlShiftToRight(ByRef num)
-Range("A152").Clear
-Range("B152").Clear
-Range("C152").Clear
-Range("D152").Clear
-Range("A152").Value = "xlShiftToRight"
-Range("B152").Value = -4161
-Range("C152").Value = num
-B152 = Range("B152").Value
-C152 = Range("C152").Value
-If B152 = C152 Then
-Range("D152").Value = "OK"
-Else
-Range("D152").Value = "NG"
-End If
-End Function
-
-Function test_xlOutline(ByRef num)
-Range("A153").Clear
-Range("B153").Clear
-Range("C153").Clear
-Range("D153").Clear
-Range("A153").Value = "xlOutline"
-Range("B153").Value = 1
-Range("C153").Value = num
-B153 = Range("B153").Value
-C153 = Range("C153").Value
-If B153 = C153 Then
-Range("D153").Value = "OK"
-Else
-Range("D153").Value = "NG"
-End If
-End Function
-
-Function test_xlTabular(ByRef num)
-Range("A154").Clear
-Range("B154").Clear
-Range("C154").Clear
-Range("D154").Clear
-Range("A154").Value = "xlTabular"
-Range("B154").Value = 0
-Range("C154").Value = num
-B154 = Range("B154").Value
-C154 = Range("C154").Value
-If B154 = C154 Then
-Range("D154").Value = "OK"
-Else
-Range("D154").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendPositionBottom(ByRef num)
-Range("A155").Clear
-Range("B155").Clear
-Range("C155").Clear
-Range("D155").Clear
-Range("A155").Value = "xlLegendPositionBottom"
-Range("B155").Value = -4107
-Range("C155").Value = num
-B155 = Range("B155").Value
-C155 = Range("C155").Value
-If B155 = C155 Then
-Range("D155").Value = "OK"
-Else
-Range("D155").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendPositionCorner(ByRef num)
-Range("A156").Clear
-Range("B156").Clear
-Range("C156").Clear
-Range("D156").Clear
-Range("A156").Value = "xlLegendPositionCorner"
-Range("B156").Value = 2
-Range("C156").Value = num
-B156 = Range("B156").Value
-C156 = Range("C156").Value
-If B156 = C156 Then
-Range("D156").Value = "OK"
-Else
-Range("D156").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendPositionLeft(ByRef num)
-Range("A157").Clear
-Range("B157").Clear
-Range("C157").Clear
-Range("D157").Clear
-Range("A157").Value = "xlLegendPositionLeft"
-Range("B157").Value = -4131
-Range("C157").Value = num
-B157 = Range("B157").Value
-C157 = Range("C157").Value
-If B157 = C157 Then
-Range("D157").Value = "OK"
-Else
-Range("D157").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendPositionRight(ByRef num)
-Range("A158").Clear
-Range("B158").Clear
-Range("C158").Clear
-Range("D158").Clear
-Range("A158").Value = "xlLegendPositionRight"
-Range("B158").Value = -4152
-Range("C158").Value = num
-B158 = Range("B158").Value
-C158 = Range("C158").Value
-If B158 = C158 Then
-Range("D158").Value = "OK"
-Else
-Range("D158").Value = "NG"
-End If
-End Function
-
-Function test_xlLegendPositionTop(ByRef num)
-Range("A159").Clear
-Range("B159").Clear
-Range("C159").Clear
-Range("D159").Clear
-Range("A159").Value = "xlLegendPositionTop"
-Range("B159").Value = -4160
-Range("C159").Value = num
-B159 = Range("B159").Value
-C159 = Range("C159").Value
-If B159 = C159 Then
-Range("D159").Value = "OK"
-Else
-Range("D159").Value = "NG"
-End If
-End Function
-
-Function test_xlContinuous(ByRef num)
-Range("A160").Clear
-Range("B160").Clear
-Range("C160").Clear
-Range("D160").Clear
-Range("A160").Value = "xlContinuous"
-Range("B160").Value = 1
-Range("C160").Value = num
-B160 = Range("B160").Value
-C160 = Range("C160").Value
-If B160 = C160 Then
-Range("D160").Value = "OK"
-Else
-Range("D160").Value = "NG"
-End If
-End Function
-
-Function test_xlDash(ByRef num)
-Range("A161").Clear
-Range("B161").Clear
-Range("C161").Clear
-Range("D161").Clear
-Range("A161").Value = "xlDash"
-Range("B161").Value = -4115
-Range("C161").Value = num
-B161 = Range("B161").Value
-C161 = Range("C161").Value
-If B161 = C161 Then
-Range("D161").Value = "OK"
-Else
-Range("D161").Value = "NG"
-End If
-End Function
-
-Function test_xlDashDot(ByRef num)
-Range("A162").Clear
-Range("B162").Clear
-Range("C162").Clear
-Range("D162").Clear
-Range("A162").Value = "xlDashDot"
-Range("B162").Value = 4
-Range("C162").Value = num
-B162 = Range("B162").Value
-C162 = Range("C162").Value
-If B162 = C162 Then
-Range("D162").Value = "OK"
-Else
-Range("D162").Value = "NG"
-End If
-End Function
-
-Function test_xlDashDotDot(ByRef num)
-Range("A163").Clear
-Range("B163").Clear
-Range("C163").Clear
-Range("D163").Clear
-Range("A163").Value = "xlDashDotDot"
-Range("B163").Value = 5
-Range("C163").Value = num
-B163 = Range("B163").Value
-C163 = Range("C163").Value
-If B163 = C163 Then
-Range("D163").Value = "OK"
-Else
-Range("D163").Value = "NG"
-End If
-End Function
-
-Function test_xlDot(ByRef num)
-Range("A164").Clear
-Range("B164").Clear
-Range("C164").Clear
-Range("D164").Clear
-Range("A164").Value = "xlDot"
-Range("B164").Value = -4118
-Range("C164").Value = num
-B164 = Range("B164").Value
-C164 = Range("C164").Value
-If B164 = C164 Then
-Range("D164").Value = "OK"
-Else
-Range("D164").Value = "NG"
-End If
-End Function
-
-Function test_xlDouble(ByRef num)
-Range("A165").Clear
-Range("B165").Clear
-Range("C165").Clear
-Range("D165").Clear
-Range("A165").Value = "xlDouble"
-Range("B165").Value = -4119
-Range("C165").Value = num
-B165 = Range("B165").Value
-C165 = Range("C165").Value
-If B165 = C165 Then
-Range("D165").Value = "OK"
-Else
-Range("D165").Value = "NG"
-End If
-End Function
-
-Function test_xlLineStyleNone(ByRef num)
-Range("A166").Clear
-Range("B166").Clear
-Range("C166").Clear
-Range("D166").Clear
-Range("A166").Value = "xlLineStyleNone"
-Range("B166").Value = -4142
-Range("C166").Value = num
-B166 = Range("B166").Value
-C166 = Range("C166").Value
-If B166 = C166 Then
-Range("D166").Value = "OK"
-Else
-Range("D166").Value = "NG"
-End If
-End Function
-
-Function test_xlSlantDashDot(ByRef num)
-Range("A167").Clear
-Range("B167").Clear
-Range("C167").Clear
-Range("D167").Clear
-Range("A167").Value = "xlSlantDashDot"
-Range("B167").Value = 13
-Range("C167").Value = num
-B167 = Range("B167").Value
-C167 = Range("C167").Value
-If B167 = C167 Then
-Range("D167").Value = "OK"
-Else
-Range("D167").Value = "NG"
-End If
-End Function
-
-Function test_xlExcelLink(ByRef num)
-Range("A168").Clear
-Range("B168").Clear
-Range("C168").Clear
-Range("D168").Clear
-Range("A168").Value = "xlExcelLink"
-Range("B168").Value = 1
-Range("C168").Value = num
-B168 = Range("B168").Value
-C168 = Range("C168").Value
-If B168 = C168 Then
-Range("D168").Value = "OK"
-Else
-Range("D168").Value = "NG"
-End If
-End Function
-
-Function test_XlOLELink(ByRef num)
-Range("A169").Clear
-Range("B169").Clear
-Range("C169").Clear
-Range("D169").Clear
-Range("A169").Value = "xlOLELink"
-Range("B169").Value = 2
-Range("C169").Value = num
-B169 = Range("B169").Value
-C169 = Range("C169").Value
-If B169 = C169 Then
-Range("D169").Value = "OK"
-Else
-Range("D169").Value = "NG"
-End If
-End Function
-
-Function test_xlPublishers(ByRef num)
-Range("A170").Clear
-Range("B170").Clear
-Range("C170").Clear
-Range("D170").Clear
-Range("A170").Value = "xlPublishers"
-Range("B170").Value = 5
-Range("C170").Value = num
-B170 = Range("B170").Value
-C170 = Range("C170").Value
-If B170 = C170 Then
-Range("D170").Value = "OK"
-Else
-Range("D170").Value = "NG"
-End If
-End Function
-
-Function test_xlSubscribers(ByRef num)
-Range("A171").Clear
-Range("B171").Clear
-Range("C171").Clear
-Range("D171").Clear
-Range("A171").Value = "xlSubscribers"
-Range("B171").Value = 6
-Range("C171").Value = num
-B171 = Range("B171").Value
-C171 = Range("C171").Value
-If B171 = C171 Then
-Range("D171").Value = "OK"
-Else
-Range("D171").Value = "NG"
-End If
-End Function
-
-Function test_xlEditionDate(ByRef num)
-Range("A172").Clear
-Range("B172").Clear
-Range("C172").Clear
-Range("D172").Clear
-Range("A172").Value = "xlEditionDate"
-Range("B172").Value = 2
-Range("C172").Value = num
-B172 = Range("B172").Value
-C172 = Range("C172").Value
-If B172 = C172 Then
-Range("D172").Value = "OK"
-Else
-Range("D172").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkInfoStatus(ByRef num)
-Range("A173").Clear
-Range("B173").Clear
-Range("C173").Clear
-Range("D173").Clear
-Range("A173").Value = "xlLinkInfoStatus"
-Range("B173").Value = 3
-Range("C173").Value = num
-B173 = Range("B173").Value
-C173 = Range("C173").Value
-If B173 = C173 Then
-Range("D173").Value = "OK"
-Else
-Range("D173").Value = "NG"
-End If
-End Function
-
-Function test_xlUpdateState(ByRef num)
-Range("A174").Clear
-Range("B174").Clear
-Range("C174").Clear
-Range("D174").Clear
-Range("A174").Value = "xlUpdateState"
-Range("B174").Value = 1
-Range("C174").Value = num
-B174 = Range("B174").Value
-C174 = Range("C174").Value
-If B174 = C174 Then
-Range("D174").Value = "OK"
-Else
-Range("D174").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkInfoOLELinks(ByRef num)
-Range("A175").Clear
-Range("B175").Clear
-Range("C175").Clear
-Range("D175").Clear
-Range("A175").Value = "xlLinkInfoOLELinks"
-Range("B175").Value = 2
-Range("C175").Value = num
-B175 = Range("B175").Value
-C175 = Range("C175").Value
-If B175 = C175 Then
-Range("D175").Value = "OK"
-Else
-Range("D175").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkInfoPublishers(ByRef num)
-Range("A176").Clear
-Range("B176").Clear
-Range("C176").Clear
-Range("D176").Clear
-Range("A176").Value = "xlLinkInfoPublishers"
-Range("B176").Value = 5
-Range("C176").Value = num
-B176 = Range("B176").Value
-C176 = Range("C176").Value
-If B176 = C176 Then
-Range("D176").Value = "OK"
-Else
-Range("D176").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkInfoSubscribers(ByRef num)
-Range("A177").Clear
-Range("B177").Clear
-Range("C177").Clear
-Range("D177").Clear
-Range("A177").Value = "xlLinkInfoSubscribers"
-Range("B177").Value = 6
-Range("C177").Value = num
-B177 = Range("B177").Value
-C177 = Range("C177").Value
-If B177 = C177 Then
-Range("D177").Value = "OK"
-Else
-Range("D177").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusCopiedValues(ByRef num)
-Range("A178").Clear
-Range("B178").Clear
-Range("C178").Clear
-Range("D178").Clear
-Range("A178").Value = "xlLinkStatusCopiedValues"
-Range("B178").Value = 10
-Range("C178").Value = num
-B178 = Range("B178").Value
-C178 = Range("C178").Value
-If B178 = C178 Then
-Range("D178").Value = "OK"
-Else
-Range("D178").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusIndeterminate(ByRef num)
-Range("A179").Clear
-Range("B179").Clear
-Range("C179").Clear
-Range("D179").Clear
-Range("A179").Value = "xlLinkStatusIndeterminate"
-Range("B179").Value = 5
-Range("C179").Value = num
-B179 = Range("B179").Value
-C179 = Range("C179").Value
-If B179 = C179 Then
-Range("D179").Value = "OK"
-Else
-Range("D179").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusInvalidName(ByRef num)
-Range("A180").Clear
-Range("B180").Clear
-Range("C180").Clear
-Range("D180").Clear
-Range("A180").Value = "xlLinkStatusInvalidName"
-Range("B180").Value = 7
-Range("C180").Value = num
-B180 = Range("B180").Value
-C180 = Range("C180").Value
-If B180 = C180 Then
-Range("D180").Value = "OK"
-Else
-Range("D180").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusMissingFile(ByRef num)
-Range("A181").Clear
-Range("B181").Clear
-Range("C181").Clear
-Range("D181").Clear
-Range("A181").Value = "xlLinkStatusMissingFile"
-Range("B181").Value = 1
-Range("C181").Value = num
-B181 = Range("B181").Value
-C181 = Range("C181").Value
-If B181 = C181 Then
-Range("D181").Value = "OK"
-Else
-Range("D181").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusMissingSheet(ByRef num)
-Range("A182").Clear
-Range("B182").Clear
-Range("C182").Clear
-Range("D182").Clear
-Range("A182").Value = "xlLinkStatusMissingSheet"
-Range("B182").Value = 2
-Range("C182").Value = num
-B182 = Range("B182").Value
-C182 = Range("C182").Value
-If B182 = C182 Then
-Range("D182").Value = "OK"
-Else
-Range("D182").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusNotStarted(ByRef num)
-Range("A183").Clear
-Range("B183").Clear
-Range("C183").Clear
-Range("D183").Clear
-Range("A183").Value = "xlLinkStatusNotStarted"
-Range("B183").Value = 6
-Range("C183").Value = num
-B183 = Range("B183").Value
-C183 = Range("C183").Value
-If B183 = C183 Then
-Range("D183").Value = "OK"
-Else
-Range("D183").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusOK(ByRef num)
-Range("A184").Clear
-Range("B184").Clear
-Range("C184").Clear
-Range("D184").Clear
-Range("A184").Value = "xlLinkStatusOK"
-Range("B184").Value = 0
-Range("C184").Value = num
-B184 = Range("B184").Value
-C184 = Range("C184").Value
-If B184 = C184 Then
-Range("D184").Value = "OK"
-Else
-Range("D184").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusOld(ByRef num)
-Range("A185").Clear
-Range("B185").Clear
-Range("C185").Clear
-Range("D185").Clear
-Range("A185").Value = "xlLinkStatusOld"
-Range("B185").Value = 3
-Range("C185").Value = num
-B185 = Range("B185").Value
-C185 = Range("C185").Value
-If B185 = C185 Then
-Range("D185").Value = "OK"
-Else
-Range("D185").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusSourceNotCalculated(ByRef num)
-Range("A186").Clear
-Range("B186").Clear
-Range("C186").Clear
-Range("D186").Clear
-Range("A186").Value = "xlLinkStatusSourceNotCalculated"
-Range("B186").Value = 4
-Range("C186").Value = num
-B186 = Range("B186").Value
-C186 = Range("C186").Value
-If B186 = C186 Then
-Range("D186").Value = "OK"
-Else
-Range("D186").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusSourceNotOpen(ByRef num)
-Range("A187").Clear
-Range("B187").Clear
-Range("C187").Clear
-Range("D187").Clear
-Range("A187").Value = "xlLinkStatusSourceNotOpen"
-Range("B187").Value = 8
-Range("C187").Value = num
-B187 = Range("B187").Value
-C187 = Range("C187").Value
-If B187 = C187 Then
-Range("D187").Value = "OK"
-Else
-Range("D187").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkStatusSourceOpen(ByRef num)
-Range("A188").Clear
-Range("B188").Clear
-Range("C188").Clear
-Range("D188").Clear
-Range("A188").Value = "xlLinkStatusSourceOpen"
-Range("B188").Value = 9
-Range("C188").Value = num
-B188 = Range("B188").Value
-C188 = Range("C188").Value
-If B188 = C188 Then
-Range("D188").Value = "OK"
-Else
-Range("D188").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkTypeExcelLinks(ByRef num)
-Range("A189").Clear
-Range("B189").Clear
-Range("C189").Clear
-Range("D189").Clear
-Range("A189").Value = "xlLinkTypeExcelLinks"
-Range("B189").Value = 1
-Range("C189").Value = num
-B189 = Range("B189").Value
-C189 = Range("C189").Value
-If B189 = C189 Then
-Range("D189").Value = "OK"
-Else
-Range("D189").Value = "NG"
-End If
-End Function
-
-Function test_xlLinkTypeOLELinks(ByRef num)
-Range("A190").Clear
-Range("B190").Clear
-Range("C190").Clear
-Range("D190").Clear
-Range("A190").Value = "xlLinkTypeOLELinks"
-Range("B190").Value = 2
-Range("C190").Value = num
-B190 = Range("B190").Value
-C190 = Range("C190").Value
-If B190 = C190 Then
-Range("D190").Value = "OK"
-Else
-Range("D190").Value = "NG"
-End If
-End Function
-
-Function test_xlListConflictDialog(ByRef num)
-Range("A191").Clear
-Range("B191").Clear
-Range("C191").Clear
-Range("D191").Clear
-Range("A191").Value = "xlListConflictDialog"
-Range("B191").Value = 0
-Range("C191").Value = num
-B191 = Range("B191").Value
-C191 = Range("C191").Value
-If B191 = C191 Then
-Range("D191").Value = "OK"
-Else
-Range("D191").Value = "NG"
-End If
-End Function
-
-Function test_xlListConflictDiscardAllConflicts(ByRef num)
-Range("A192").Clear
-Range("B192").Clear
-Range("C192").Clear
-Range("D192").Clear
-Range("A192").Value = "xlListConflictDiscardAllConflicts"
-Range("B192").Value = 2
-Range("C192").Value = num
-B192 = Range("B192").Value
-C192 = Range("C192").Value
-If B192 = C192 Then
-Range("D192").Value = "OK"
-Else
-Range("D192").Value = "NG"
-End If
-End Function
-
-Function test_xlListConflictError(ByRef num)
-Range("A193").Clear
-Range("B193").Clear
-Range("C193").Clear
-Range("D193").Clear
-Range("A193").Value = "xlListConflictError"
-Range("B193").Value = 3
-Range("C193").Value = num
-B193 = Range("B193").Value
-C193 = Range("C193").Value
-If B193 = C193 Then
-Range("D193").Value = "OK"
-Else
-Range("D193").Value = "NG"
-End If
-End Function
-
-Function test_xlListConflictRetryAllConflicts(ByRef num)
-Range("A194").Clear
-Range("B194").Clear
-Range("C194").Clear
-Range("D194").Clear
-Range("A194").Value = "xlListConflictRetryAllConflicts"
-Range("B194").Value = 1
-Range("C194").Value = num
-B194 = Range("B194").Value
-C194 = Range("C194").Value
-If B194 = C194 Then
-Range("D194").Value = "OK"
-Else
-Range("D194").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeCheckbox(ByRef num)
-Range("A195").Clear
-Range("B195").Clear
-Range("C195").Clear
-Range("D195").Clear
-Range("A195").Value = "xlListDataTypeCheckbox"
-Range("B195").Value = 9
-Range("C195").Value = num
-B195 = Range("B195").Value
-C195 = Range("C195").Value
-If B195 = C195 Then
-Range("D195").Value = "OK"
-Else
-Range("D195").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeChoice(ByRef num)
-Range("A196").Clear
-Range("B196").Clear
-Range("C196").Clear
-Range("D196").Clear
-Range("A196").Value = "xlListDataTypeChoice"
-Range("B196").Value = 6
-Range("C196").Value = num
-B196 = Range("B196").Value
-C196 = Range("C196").Value
-If B196 = C196 Then
-Range("D196").Value = "OK"
-Else
-Range("D196").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeChoiceMulti(ByRef num)
-Range("A197").Clear
-Range("B197").Clear
-Range("C197").Clear
-Range("D197").Clear
-Range("A197").Value = "xlListDataTypeChoiceMulti"
-Range("B197").Value = 7
-Range("C197").Value = num
-B197 = Range("B197").Value
-C197 = Range("C197").Value
-If B197 = C197 Then
-Range("D197").Value = "OK"
-Else
-Range("D197").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeCounter(ByRef num)
-Range("A198").Clear
-Range("B198").Clear
-Range("C198").Clear
-Range("D198").Clear
-Range("A198").Value = "xlListDataTypeCounter"
-Range("B198").Value = 11
-Range("C198").Value = num
-B198 = Range("B198").Value
-C198 = Range("C198").Value
-If B198 = C198 Then
-Range("D198").Value = "OK"
-Else
-Range("D198").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeCurrency(ByRef num)
-Range("A199").Clear
-Range("B199").Clear
-Range("C199").Clear
-Range("D199").Clear
-Range("A199").Value = "xlListDataTypeCurrency"
-Range("B199").Value = 4
-Range("C199").Value = num
-B199 = Range("B199").Value
-C199 = Range("C199").Value
-If B199 = C199 Then
-Range("D199").Value = "OK"
-Else
-Range("D199").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeDateTime(ByRef num)
-Range("A200").Clear
-Range("B200").Clear
-Range("C200").Clear
-Range("D200").Clear
-Range("A200").Value = "xlListDataTypeDateTime"
-Range("B200").Value = 5
-Range("C200").Value = num
-B200 = Range("B200").Value
-C200 = Range("C200").Value
-If B200 = C200 Then
-Range("D200").Value = "OK"
-Else
-Range("D200").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeHyperLink(ByRef num)
-Range("A201").Clear
-Range("B201").Clear
-Range("C201").Clear
-Range("D201").Clear
-Range("A201").Value = "xlListDataTypeHyperLink"
-Range("B201").Value = 10
-Range("C201").Value = num
-B201 = Range("B201").Value
-C201 = Range("C201").Value
-If B201 = C201 Then
-Range("D201").Value = "OK"
-Else
-Range("D201").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeListLookup(ByRef num)
-Range("A202").Clear
-Range("B202").Clear
-Range("C202").Clear
-Range("D202").Clear
-Range("A202").Value = "xlListDataTypeListLookup"
-Range("B202").Value = 8
-Range("C202").Value = num
-B202 = Range("B202").Value
-C202 = Range("C202").Value
-If B202 = C202 Then
-Range("D202").Value = "OK"
-Else
-Range("D202").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeMultiLineRichText(ByRef num)
-Range("A203").Clear
-Range("B203").Clear
-Range("C203").Clear
-Range("D203").Clear
-Range("A203").Value = "xlListDataTypeMultiLineRichText"
-Range("B203").Value = 12
-Range("C203").Value = num
-B203 = Range("B203").Value
-C203 = Range("C203").Value
-If B203 = C203 Then
-Range("D203").Value = "OK"
-Else
-Range("D203").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeMultiLineText(ByRef num)
-Range("A204").Clear
-Range("B204").Clear
-Range("C204").Clear
-Range("D204").Clear
-Range("A204").Value = "xlListDataTypeMultiLineText"
-Range("B204").Value = 2
-Range("C204").Value = num
-B204 = Range("B204").Value
-C204 = Range("C204").Value
-If B204 = C204 Then
-Range("D204").Value = "OK"
-Else
-Range("D204").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeNone(ByRef num)
-Range("A205").Clear
-Range("B205").Clear
-Range("C205").Clear
-Range("D205").Clear
-Range("A205").Value = "xlListDataTypeNone"
-Range("B205").Value = 0
-Range("C205").Value = num
-B205 = Range("B205").Value
-C205 = Range("C205").Value
-If B205 = C205 Then
-Range("D205").Value = "OK"
-Else
-Range("D205").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeNumber(ByRef num)
-Range("A206").Clear
-Range("B206").Clear
-Range("C206").Clear
-Range("D206").Clear
-Range("A206").Value = "xlListDataTypeNumber"
-Range("B206").Value = 3
-Range("C206").Value = num
-B206 = Range("B206").Value
-C206 = Range("C206").Value
-If B206 = C206 Then
-Range("D206").Value = "OK"
-Else
-Range("D206").Value = "NG"
-End If
-End Function
-
-Function test_xlListDataTypeText(ByRef num)
-Range("A207").Clear
-Range("B207").Clear
-Range("C207").Clear
-Range("D207").Clear
-Range("A207").Value = "xlListDataTypeText"
-Range("B207").Value = 1
-Range("C207").Value = num
-B207 = Range("B207").Value
-C207 = Range("C207").Value
-If B207 = C207 Then
-Range("D207").Value = "OK"
-Else
-Range("D207").Value = "NG"
-End If
-End Function
-
-Function test_xlSrcExternal(ByRef num)
-Range("A208").Clear
-Range("B208").Clear
-Range("C208").Clear
-Range("D208").Clear
-Range("A208").Value = "xlSrcExternal"
-Range("B208").Value = 0
-Range("C208").Value = num
-B208 = Range("B208").Value
-C208 = Range("C208").Value
-If B208 = C208 Then
-Range("D208").Value = "OK"
-Else
-Range("D208").Value = "NG"
-End If
-End Function
-
-Function test_xlSrcRange(ByRef num)
-Range("A209").Clear
-Range("B209").Clear
-Range("C209").Clear
-Range("D209").Clear
-Range("A209").Value = "xlSrcRange"
-Range("B209").Value = 1
-Range("C209").Value = num
-B209 = Range("B209").Value
-C209 = Range("C209").Value
-If B209 = C209 Then
-Range("D209").Value = "OK"
-Else
-Range("D209").Value = "NG"
-End If
-End Function
-
-Function test_xlSrcXml(ByRef num)
-Range("A210").Clear
-Range("B210").Clear
-Range("C210").Clear
-Range("D210").Clear
-Range("A210").Value = "xlSrcXml"
-Range("B210").Value = 2
-Range("C210").Value = num
-B210 = Range("B210").Value
-C210 = Range("C210").Value
-If B210 = C210 Then
-Range("D210").Value = "OK"
-Else
-Range("D210").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnHeader(ByRef num)
-Range("A211").Clear
-Range("B211").Clear
-Range("C211").Clear
-Range("D211").Clear
-Range("A211").Value = "xlColumnHeader"
-Range("B211").Value = -4110
-Range("C211").Value = num
-B211 = Range("B211").Value
-C211 = Range("C211").Value
-If B211 = C211 Then
-Range("D211").Value = "OK"
-Else
-Range("D211").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnItem(ByRef num)
-Range("A212").Clear
-Range("B212").Clear
-Range("C212").Clear
-Range("D212").Clear
-Range("A212").Value = "xlColumnItem"
-Range("B212").Value = 5
-Range("C212").Value = num
-B212 = Range("B212").Value
-C212 = Range("C212").Value
-If B212 = C212 Then
-Range("D212").Value = "OK"
-Else
-Range("D212").Value = "NG"
-End If
-End Function
-
-Function test_xlDataHeader(ByRef num)
-Range("A213").Clear
-Range("B213").Clear
-Range("C213").Clear
-Range("D213").Clear
-Range("A213").Value = "xlDataHeader"
-Range("B213").Value = 3
-Range("C213").Value = num
-B213 = Range("B213").Value
-C213 = Range("C213").Value
-If B213 = C213 Then
-Range("D213").Value = "OK"
-Else
-Range("D213").Value = "NG"
-End If
-End Function
-
-Function test_xlDataItem(ByRef num)
-Range("A214").Clear
-Range("B214").Clear
-Range("C214").Clear
-Range("D214").Clear
-Range("A214").Value = "xlDataItem"
-Range("B214").Value = 7
-Range("C214").Value = num
-B214 = Range("B214").Value
-C214 = Range("C214").Value
-If B214 = C214 Then
-Range("D214").Value = "OK"
-Else
-Range("D214").Value = "NG"
-End If
-End Function
-
-Function test_xlPageHeader(ByRef num)
-Range("A215").Clear
-Range("B215").Clear
-Range("C215").Clear
-Range("D215").Clear
-Range("A215").Value = "xlPageHeader"
-Range("B215").Value = 2
-Range("C215").Value = num
-B215 = Range("B215").Value
-C215 = Range("C215").Value
-If B215 = C215 Then
-Range("D215").Value = "OK"
-Else
-Range("D215").Value = "NG"
-End If
-End Function
-
-Function test_xlPageItem(ByRef num)
-Range("A216").Clear
-Range("B216").Clear
-Range("C216").Clear
-Range("D216").Clear
-Range("A216").Value = "xlPageItem"
-Range("B216").Value = 6
-Range("C216").Value = num
-B216 = Range("B216").Value
-C216 = Range("C216").Value
-If B216 = C216 Then
-Range("D216").Value = "OK"
-Else
-Range("D216").Value = "NG"
-End If
-End Function
-
-Function test_xlRowHeader(ByRef num)
-Range("A217").Clear
-Range("B217").Clear
-Range("C217").Clear
-Range("D217").Clear
-Range("A217").Value = "xlRowHeader"
-Range("B217").Value = -4153
-Range("C217").Value = num
-B217 = Range("B217").Value
-C217 = Range("C217").Value
-If B217 = C217 Then
-Range("D217").Value = "OK"
-Else
-Range("D217").Value = "NG"
-End If
-End Function
-
-Function test_xlRowItem(ByRef num)
-Range("A218").Clear
-Range("B218").Clear
-Range("C218").Clear
-Range("D218").Clear
-Range("A218").Value = "xlRowItem"
-Range("B218").Value = 4
-Range("C218").Value = num
-B218 = Range("B218").Value
-C218 = Range("C218").Value
-If B218 = C218 Then
-Range("D218").Value = "OK"
-Else
-Range("D218").Value = "NG"
-End If
-End Function
-
-Function test_xlTableBody(ByRef num)
-Range("A219").Clear
-Range("B219").Clear
-Range("C219").Clear
-Range("D219").Clear
-Range("A219").Value = "xlTableBody"
-Range("B219").Value = 8
-Range("C219").Value = num
-B219 = Range("B219").Value
-C219 = Range("C219").Value
-If B219 = C219 Then
-Range("D219").Value = "OK"
-Else
-Range("D219").Value = "NG"
-End If
-End Function
-
-Function test_xlPart(ByRef num)
-Range("A220").Clear
-Range("B220").Clear
-Range("C220").Clear
-Range("D220").Clear
-Range("A220").Value = "xlPart"
-Range("B220").Value = 2
-Range("C220").Value = num
-B220 = Range("B220").Value
-C220 = Range("C220").Value
-If B220 = C220 Then
-Range("D220").Value = "OK"
-Else
-Range("D220").Value = "NG"
-End If
-End Function
-
-Function test_xlWhole(ByRef num)
-Range("A221").Clear
-Range("B221").Clear
-Range("C221").Clear
-Range("D221").Clear
-Range("A221").Value = "xlWhole"
-Range("B221").Value = 1
-Range("C221").Value = num
-B221 = Range("B221").Value
-C221 = Range("C221").Value
-If B221 = C221 Then
-Range("D221").Value = "OK"
-Else
-Range("D221").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftAccess(ByRef num)
-Range("A222").Clear
-Range("B222").Clear
-Range("C222").Clear
-Range("D222").Clear
-Range("A222").Value = "xlMicrosoftAccess"
-Range("B222").Value = 4
-Range("C222").Value = num
-B222 = Range("B222").Value
-C222 = Range("C222").Value
-If B222 = C222 Then
-Range("D222").Value = "OK"
-Else
-Range("D222").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftFoxPro(ByRef num)
-Range("A223").Clear
-Range("B223").Clear
-Range("C223").Clear
-Range("D223").Clear
-Range("A223").Value = "xlMicrosoftFoxPro"
-Range("B223").Value = 5
-Range("C223").Value = num
-B223 = Range("B223").Value
-C223 = Range("C223").Value
-If B223 = C223 Then
-Range("D223").Value = "OK"
-Else
-Range("D223").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftMail(ByRef num)
-Range("A224").Clear
-Range("B224").Clear
-Range("C224").Clear
-Range("D224").Clear
-Range("A224").Value = "xlMicrosoftMail"
-Range("B224").Value = 3
-Range("C224").Value = num
-B224 = Range("B224").Value
-C224 = Range("C224").Value
-If B224 = C224 Then
-Range("D224").Value = "OK"
-Else
-Range("D224").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftPowerPoint(ByRef num)
-Range("A225").Clear
-Range("B225").Clear
-Range("C225").Clear
-Range("D225").Clear
-Range("A225").Value = "xlMicrosoftPowerPoint"
-Range("B225").Value = 2
-Range("C225").Value = num
-B225 = Range("B225").Value
-C225 = Range("C225").Value
-If B225 = C225 Then
-Range("D225").Value = "OK"
-Else
-Range("D225").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftProject(ByRef num)
-Range("A226").Clear
-Range("B226").Clear
-Range("C226").Clear
-Range("D226").Clear
-Range("A226").Value = "xlMicrosoftProject"
-Range("B226").Value = 6
-Range("C226").Value = num
-B226 = Range("B226").Value
-C226 = Range("C226").Value
-If B226 = C226 Then
-Range("D226").Value = "OK"
-Else
-Range("D226").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftSchedulePlus(ByRef num)
-Range("A227").Clear
-Range("B227").Clear
-Range("C227").Clear
-Range("D227").Clear
-Range("A227").Value = "xlMicrosoftSchedulePlus"
-Range("B227").Value = 7
-Range("C227").Value = num
-B227 = Range("B227").Value
-C227 = Range("C227").Value
-If B227 = C227 Then
-Range("D227").Value = "OK"
-Else
-Range("D227").Value = "NG"
-End If
-End Function
-
-Function test_xlMicrosoftWord(ByRef num)
-Range("A228").Clear
-Range("B228").Clear
-Range("C228").Clear
-Range("D228").Clear
-Range("A228").Value = "xlMicrosoftWord"
-Range("B228").Value = 1
-Range("C228").Value = num
-B228 = Range("B228").Value
-C228 = Range("C228").Value
-If B228 = C228 Then
-Range("D228").Value = "OK"
-Else
-Range("D228").Value = "NG"
-End If
-End Function
-
-Function test_xlMAPI(ByRef num)
-Range("A229").Clear
-Range("B229").Clear
-Range("C229").Clear
-Range("D229").Clear
-Range("A229").Value = "xlMAPI"
-Range("B229").Value = 1
-Range("C229").Value = num
-B229 = Range("B229").Value
-C229 = Range("C229").Value
-If B229 = C229 Then
-Range("D229").Value = "OK"
-Else
-Range("D229").Value = "NG"
-End If
-End Function
-
-Function test_xlNoMailSystem(ByRef num)
-Range("A230").Clear
-Range("B230").Clear
-Range("C230").Clear
-Range("D230").Clear
-Range("A230").Value = "xlNoMailSystem"
-Range("B230").Value = 0
-Range("C230").Value = num
-B230 = Range("B230").Value
-C230 = Range("C230").Value
-If B230 = C230 Then
-Range("D230").Value = "OK"
-Else
-Range("D230").Value = "NG"
-End If
-End Function
-
-Function test_xlPowerTalk(ByRef num)
-Range("A231").Clear
-Range("B231").Clear
-Range("C231").Clear
-Range("D231").Clear
-Range("A231").Value = "xlPowerTalk"
-Range("B231").Value = 2
-Range("C231").Value = num
-B231 = Range("B231").Value
-C231 = Range("C231").Value
-If B231 = C231 Then
-Range("D231").Value = "OK"
-Else
-Range("D231").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleAutomatic(ByRef num)
-Range("A232").Clear
-Range("B232").Clear
-Range("C232").Clear
-Range("D232").Clear
-Range("A232").Value = "xlMarkerStyleAutomatic"
-Range("B232").Value = -4105
-Range("C232").Value = num
-B232 = Range("B232").Value
-C232 = Range("C232").Value
-If B232 = C232 Then
-Range("D232").Value = "OK"
-Else
-Range("D232").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleCircle(ByRef num)
-Range("A233").Clear
-Range("B233").Clear
-Range("C233").Clear
-Range("D233").Clear
-Range("A233").Value = "xlMarkerStyleCircle"
-Range("B233").Value = 8
-Range("C233").Value = num
-B233 = Range("B233").Value
-C233 = Range("C233").Value
-If B233 = C233 Then
-Range("D233").Value = "OK"
-Else
-Range("D233").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleDash(ByRef num)
-Range("A234").Clear
-Range("B234").Clear
-Range("C234").Clear
-Range("D234").Clear
-Range("A234").Value = "xlMarkerStyleDash"
-Range("B234").Value = -4115
-Range("C234").Value = num
-B234 = Range("B234").Value
-C234 = Range("C234").Value
-If B234 = C234 Then
-Range("D234").Value = "OK"
-Else
-Range("D234").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleDiamond(ByRef num)
-Range("A235").Clear
-Range("B235").Clear
-Range("C235").Clear
-Range("D235").Clear
-Range("A235").Value = "xlMarkerStyleDiamond"
-Range("B235").Value = 2
-Range("C235").Value = num
-B235 = Range("B235").Value
-C235 = Range("C235").Value
-If B235 = C235 Then
-Range("D235").Value = "OK"
-Else
-Range("D235").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleDot(ByRef num)
-Range("A236").Clear
-Range("B236").Clear
-Range("C236").Clear
-Range("D236").Clear
-Range("A236").Value = "xlMarkerStyleDot"
-Range("B236").Value = -4118
-Range("C236").Value = num
-B236 = Range("B236").Value
-C236 = Range("C236").Value
-If B236 = C236 Then
-Range("D236").Value = "OK"
-Else
-Range("D236").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleNone(ByRef num)
-Range("A237").Clear
-Range("B237").Clear
-Range("C237").Clear
-Range("D237").Clear
-Range("A237").Value = "xlMarkerStyleNone"
-Range("B237").Value = -4142
-Range("C237").Value = num
-B237 = Range("B237").Value
-C237 = Range("C237").Value
-If B237 = C237 Then
-Range("D237").Value = "OK"
-Else
-Range("D237").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStylePicture(ByRef num)
-Range("A238").Clear
-Range("B238").Clear
-Range("C238").Clear
-Range("D238").Clear
-Range("A238").Value = "xlMarkerStylePicture"
-Range("B238").Value = -4147
-Range("C238").Value = num
-B238 = Range("B238").Value
-C238 = Range("C238").Value
-If B238 = C238 Then
-Range("D238").Value = "OK"
-Else
-Range("D238").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStylePlus(ByRef num)
-Range("A239").Clear
-Range("B239").Clear
-Range("C239").Clear
-Range("D239").Clear
-Range("A239").Value = "xlMarkerStylePlus"
-Range("B239").Value = 9
-Range("C239").Value = num
-B239 = Range("B239").Value
-C239 = Range("C239").Value
-If B239 = C239 Then
-Range("D239").Value = "OK"
-Else
-Range("D239").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleSquare(ByRef num)
-Range("A240").Clear
-Range("B240").Clear
-Range("C240").Clear
-Range("D240").Clear
-Range("A240").Value = "xlMarkerStyleSquare"
-Range("B240").Value = 1
-Range("C240").Value = num
-B240 = Range("B240").Value
-C240 = Range("C240").Value
-If B240 = C240 Then
-Range("D240").Value = "OK"
-Else
-Range("D240").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleStar(ByRef num)
-Range("A241").Clear
-Range("B241").Clear
-Range("C241").Clear
-Range("D241").Clear
-Range("A241").Value = "xlMarkerStyleStar"
-Range("B241").Value = 5
-Range("C241").Value = num
-B241 = Range("B241").Value
-C241 = Range("C241").Value
-If B241 = C241 Then
-Range("D241").Value = "OK"
-Else
-Range("D241").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleTiangle(ByRef num)
-Range("A242").Clear
-Range("B242").Clear
-Range("C242").Clear
-Range("D242").Clear
-Range("A242").Value = "xlMarkerStyleTiangle"
-Range("B242").Value = 3
-Range("C242").Value = num
-B242 = Range("B242").Value
-C242 = Range("C242").Value
-If B242 = C242 Then
-Range("D242").Value = "OK"
-Else
-Range("D242").Value = "NG"
-End If
-End Function
-
-Function test_xlMarkerStyleX(ByRef num)
-Range("A243").Clear
-Range("B243").Clear
-Range("C243").Clear
-Range("D243").Clear
-Range("A243").Value = "xlMarkerStyleX"
-Range("B243").Value = -4168
-Range("C243").Value = num
-B243 = Range("B243").Value
-C243 = Range("C243").Value
-If B243 = C243 Then
-Range("D243").Value = "OK"
-Else
-Range("D243").Value = "NG"
-End If
-End Function
-
-Function test_xlNoButton(ByRef num)
-Range("A244").Clear
-Range("B244").Clear
-Range("C244").Clear
-Range("D244").Clear
-Range("A244").Value = "xlNoButton"
-Range("B244").Value = 0
-Range("C244").Value = num
-B244 = Range("B244").Value
-C244 = Range("C244").Value
-If B244 = C244 Then
-Range("D244").Value = "OK"
-Else
-Range("D244").Value = "NG"
-End If
-End Function
-
-Function test_xlPrimaryButton(ByRef num)
-Range("A245").Clear
-Range("B245").Clear
-Range("C245").Clear
-Range("D245").Clear
-Range("A245").Value = "xlPrimaryButton"
-Range("B245").Value = 1
-Range("C245").Value = num
-B245 = Range("B245").Value
-C245 = Range("C245").Value
-If B245 = C245 Then
-Range("D245").Value = "OK"
-Else
-Range("D245").Value = "NG"
-End If
-End Function
-
-Function test_xlSecondaryButton(ByRef num)
-Range("A246").Clear
-Range("B246").Clear
-Range("C246").Clear
-Range("D246").Clear
-Range("A246").Value = "xlSecondaryButton"
-Range("B246").Value = 2
-Range("C246").Value = num
-B246 = Range("B246").Value
-C246 = Range("C246").Value
-If B246 = C246 Then
-Range("D246").Value = "OK"
-Else
-Range("D246").Value = "NG"
-End If
-End Function
-
-Function test_xlDefault(ByRef num)
-Range("A247").Clear
-Range("B247").Clear
-Range("C247").Clear
-Range("D247").Clear
-Range("A247").Value = "xlDefault"
-Range("B247").Value = -4143
-Range("C247").Value = num
-B247 = Range("B247").Value
-C247 = Range("C247").Value
-If B247 = C247 Then
-Range("D247").Value = "OK"
-Else
-Range("D247").Value = "NG"
-End If
-End Function
-
-Function test_xlIBeam(ByRef num)
-Range("A248").Clear
-Range("B248").Clear
-Range("C248").Clear
-Range("D248").Clear
-Range("A248").Value = "xlIBeam"
-Range("B248").Value = 3
-Range("C248").Value = num
-B248 = Range("B248").Value
-C248 = Range("C248").Value
-If B248 = C248 Then
-Range("D248").Value = "OK"
-Else
-Range("D248").Value = "NG"
-End If
-End Function
-
-Function test_xlNorthwestArrow(ByRef num)
-Range("A249").Clear
-Range("B249").Clear
-Range("C249").Clear
-Range("D249").Clear
-Range("A249").Value = "xlNorthwestArrow"
-Range("B249").Value = 1
-Range("C249").Value = num
-B249 = Range("B249").Value
-C249 = Range("C249").Value
-If B249 = C249 Then
-Range("D249").Value = "OK"
-Else
-Range("D249").Value = "NG"
-End If
-End Function
-
-Function test_xlWait(ByRef num)
-Range("A250").Clear
-Range("B250").Clear
-Range("C250").Clear
-Range("D250").Clear
-Range("A250").Value = "xlWait"
-Range("B250").Value = 2
-Range("C250").Value = num
-B250 = Range("B250").Value
-C250 = Range("C250").Value
-If B250 = C250 Then
-Range("D250").Value = "OK"
-Else
-Range("D250").Value = "NG"
-End If
-End Function
-
-Function test_XlOLEControl(ByRef num)
-Range("A251").Clear
-Range("B251").Clear
-Range("C251").Clear
-Range("D251").Clear
-Range("A251").Value = "XlOLEControl"
-Range("B251").Value = 2
-Range("C251").Value = num
-B251 = Range("B251").Value
-C251 = Range("C251").Value
-If B251 = C251 Then
-Range("D251").Value = "OK"
-Else
-Range("D251").Value = "NG"
-End If
-End Function
-
-Function test_XlOLEEmbed(ByRef num)
-Range("A252").Clear
-Range("B252").Clear
-Range("C252").Clear
-Range("D252").Clear
-Range("A252").Value = "XlOLEEmbed"
-Range("B252").Value = 1
-Range("C252").Value = num
-B252 = Range("B252").Value
-C252 = Range("C252").Value
-If B252 = C252 Then
-Range("D252").Value = "OK"
-Else
-Range("D252").Value = "NG"
-End If
-End Function
-
-
-
-Function test_XlVerbOpen(ByRef num)
-Range("A254").Clear
-Range("B254").Clear
-Range("C254").Clear
-Range("D254").Clear
-Range("A254").Value = "XlVerbOpen"
-Range("B254").Value = 2
-Range("C254").Value = num
-B254 = Range("B254").Value
-C254 = Range("C254").Value
-If B254 = C254 Then
-Range("D254").Value = "OK"
-Else
-Range("D254").Value = "NG"
-End If
-End Function
-
-Function test_XlVerbPrimary(ByRef num)
-Range("A255").Clear
-Range("B255").Clear
-Range("C255").Clear
-Range("D255").Clear
-Range("A255").Value = "XlVerbPrimary"
-Range("B255").Value = 1
-Range("C255").Value = num
-B255 = Range("B255").Value
-C255 = Range("C255").Value
-If B255 = C255 Then
-Range("D255").Value = "OK"
-Else
-Range("D255").Value = "NG"
-End If
-End Function
-
-Function test_xlFitToPage(ByRef num)
-Range("A256").Clear
-Range("B256").Clear
-Range("C256").Clear
-Range("D256").Clear
-Range("A256").Value = "xlFitToPage"
-Range("B256").Value = 2
-Range("C256").Value = num
-B256 = Range("B256").Value
-C256 = Range("C256").Value
-If B256 = C256 Then
-Range("D256").Value = "OK"
-Else
-Range("D256").Value = "NG"
-End If
-End Function
-
-Function test_xlFullPage(ByRef num)
-Range("A257").Clear
-Range("B257").Clear
-Range("C257").Clear
-Range("D257").Clear
-Range("A257").Value = "xlFullPage"
-Range("B257").Value = 3
-Range("C257").Value = num
-B257 = Range("B257").Value
-C257 = Range("C257").Value
-If B257 = C257 Then
-Range("D257").Value = "OK"
-Else
-Range("D257").Value = "NG"
-End If
-End Function
-
-Function test_xlScreenSize(ByRef num)
-Range("A258").Clear
-Range("B258").Clear
-Range("C258").Clear
-Range("D258").Clear
-Range("A258").Value = "xlScreenSize"
-Range("B258").Value = 1
-Range("C258").Value = num
-B258 = Range("B258").Value
-C258 = Range("C258").Value
-If B258 = C258 Then
-Range("D258").Value = "OK"
-Else
-Range("D258").Value = "NG"
-End If
-End Function
-
-Function test_xlDownThenOver(ByRef num)
-Range("A259").Clear
-Range("B259").Clear
-Range("C259").Clear
-Range("D259").Clear
-Range("A259").Value = "xlDownThenOver"
-Range("B259").Value = 1
-Range("C259").Value = num
-B259 = Range("B259").Value
-C259 = Range("C259").Value
-If B259 = C259 Then
-Range("D259").Value = "OK"
-Else
-Range("D259").Value = "NG"
-End If
-End Function
-
-Function test_xlOverThenDown(ByRef num)
-Range("A260").Clear
-Range("B260").Clear
-Range("C260").Clear
-Range("D260").Clear
-Range("A260").Value = "xlOverThenDown"
-Range("B260").Value = 2
-Range("C260").Value = num
-B260 = Range("B260").Value
-C260 = Range("C260").Value
-If B260 = C260 Then
-Range("D260").Value = "OK"
-Else
-Range("D260").Value = "NG"
-End If
-End Function
-
-Function test_xlDownward(ByRef num)
-Range("A261").Clear
-Range("B261").Clear
-Range("C261").Clear
-Range("D261").Clear
-Range("A261").Value = "xlDownward"
-Range("B261").Value = -4170
-Range("C261").Value = num
-B261 = Range("B261").Value
-C261 = Range("C261").Value
-If B261 = C261 Then
-Range("D261").Value = "OK"
-Else
-Range("D261").Value = "NG"
-End If
-End Function
-
-Function test_xlHorizontal(ByRef num)
-Range("A262").Clear
-Range("B262").Clear
-Range("C262").Clear
-Range("D262").Clear
-Range("A262").Value = "xlHorizontal"
-Range("B262").Value = -4128
-Range("C262").Value = num
-B262 = Range("B262").Value
-C262 = Range("C262").Value
-If B262 = C262 Then
-Range("D262").Value = "OK"
-Else
-Range("D262").Value = "NG"
-End If
-End Function
-
-Function test_xlUpward(ByRef num)
-Range("A263").Clear
-Range("B263").Clear
-Range("C263").Clear
-Range("D263").Clear
-Range("A263").Value = "xlUpward"
-Range("B263").Value = -4171
-Range("C263").Value = num
-B263 = Range("B263").Value
-C263 = Range("C263").Value
-If B263 = C263 Then
-Range("D263").Value = "OK"
-Else
-Range("D263").Value = "NG"
-End If
-End Function
-
-Function test_xlVertical(ByRef num)
-Range("A264").Clear
-Range("B264").Clear
-Range("C264").Clear
-Range("D264").Clear
-Range("A264").Value = "xlVertical"
-Range("B264").Value = -4166
-Range("C264").Value = num
-B264 = Range("B264").Value
-C264 = Range("C264").Value
-If B264 = C264 Then
-Range("D264").Value = "OK"
-Else
-Range("D264").Value = "NG"
-End If
-End Function
-
-Function test_xlBlanks(ByRef num)
-Range("A265").Clear
-Range("B265").Clear
-Range("C265").Clear
-Range("D265").Clear
-Range("A265").Value = "xlBlanks"
-Range("B265").Value = 4
-Range("C265").Value = num
-B265 = Range("B265").Value
-C265 = Range("C265").Value
-If B265 = C265 Then
-Range("D265").Value = "OK"
-Else
-Range("D265").Value = "NG"
-End If
-End Function
-
-Function test_xlButton(ByRef num)
-Range("A266").Clear
-Range("B266").Clear
-Range("C266").Clear
-Range("D266").Clear
-Range("A266").Value = "xlButton"
-Range("B266").Value = 15
-Range("C266").Value = num
-B266 = Range("B266").Value
-C266 = Range("C266").Value
-If B266 = C266 Then
-Range("D266").Value = "OK"
-Else
-Range("D266").Value = "NG"
-End If
-End Function
-
-Function test_xlDataAndLabel(ByRef num)
-Range("A267").Clear
-Range("B267").Clear
-Range("C267").Clear
-Range("D267").Clear
-Range("A267").Value = "xlDataAndLabel"
-Range("B267").Value = 0
-Range("C267").Value = num
-B267 = Range("B267").Value
-C267 = Range("C267").Value
-If B267 = C267 Then
-Range("D267").Value = "OK"
-Else
-Range("D267").Value = "NG"
-End If
-End Function
-
-Function test_xlDataOnly(ByRef num)
-Range("A268").Clear
-Range("B268").Clear
-Range("C268").Clear
-Range("D268").Clear
-Range("A268").Value = "xlDataOnly"
-Range("B268").Value = 2
-Range("C268").Value = num
-B268 = Range("B268").Value
-C268 = Range("C268").Value
-If B268 = C268 Then
-Range("D268").Value = "OK"
-Else
-Range("D268").Value = "NG"
-End If
-End Function
-
-Function test_xlFirstRow(ByRef num)
-Range("A269").Clear
-Range("B269").Clear
-Range("C269").Clear
-Range("D269").Clear
-Range("A269").Value = "xlFirstRow"
-Range("B269").Value = 256
-Range("C269").Value = num
-B269 = Range("B269").Value
-C269 = Range("C269").Value
-If B269 = C269 Then
-Range("D269").Value = "OK"
-Else
-Range("D269").Value = "NG"
-End If
-End Function
-
-Function test_xlLabelOnly(ByRef num)
-Range("A270").Clear
-Range("B270").Clear
-Range("C270").Clear
-Range("D270").Clear
-Range("A270").Value = "xlLabelOnly"
-Range("B270").Value = 1
-Range("C270").Value = num
-B270 = Range("B270").Value
-C270 = Range("C270").Value
-If B270 = C270 Then
-Range("D270").Value = "OK"
-Else
-Range("D270").Value = "NG"
-End If
-End Function
-
-Function test_xlOrigin(ByRef num)
-Range("A271").Clear
-Range("B271").Clear
-Range("C271").Clear
-Range("D271").Clear
-Range("A271").Value = "xlOrigin"
-Range("B271").Value = 3
-Range("C271").Value = num
-B271 = Range("B271").Value
-C271 = Range("C271").Value
-If B271 = C271 Then
-Range("D271").Value = "OK"
-Else
-Range("D271").Value = "NG"
-End If
-End Function
-
-Function test_XlPageBreakAutomatic(ByRef num)
-Range("A272").Clear
-Range("B272").Clear
-Range("C272").Clear
-Range("D272").Clear
-Range("A272").Value = "XlPageBreakAutomatic"
-Range("B272").Value = -4105
-Range("C272").Value = num
-B272 = Range("B272").Value
-C272 = Range("C272").Value
-If B272 = C272 Then
-Range("D272").Value = "OK"
-Else
-Range("D272").Value = "NG"
-End If
-End Function
-
-Function test_XlPageBreakManual(ByRef num)
-Range("A273").Clear
-Range("B273").Clear
-Range("C273").Clear
-Range("D273").Clear
-Range("A273").Value = "XlPageBreakManual"
-Range("B273").Value = -4135
-Range("C273").Value = num
-B273 = Range("B273").Value
-C273 = Range("C273").Value
-If B273 = C273 Then
-Range("D273").Value = "OK"
-Else
-Range("D273").Value = "NG"
-End If
-End Function
-
-Function test_XlPageBreakNone(ByRef num)
-Range("A274").Clear
-Range("B274").Clear
-Range("C274").Clear
-Range("D274").Clear
-Range("A274").Value = "XlPageBreakNone"
-Range("B274").Value = -4142
-Range("C274").Value = num
-B274 = Range("B274").Value
-C274 = Range("C274").Value
-If B274 = C274 Then
-Range("D274").Value = "OK"
-Else
-Range("D274").Value = "NG"
-End If
-End Function
-
-Function test_xlPageBreakFull(ByRef num)
-Range("A275").Clear
-Range("B275").Clear
-Range("C275").Clear
-Range("D275").Clear
-Range("A275").Value = "xlPageBreakFull"
-Range("B275").Value = 1
-Range("C275").Value = num
-B275 = Range("B275").Value
-C275 = Range("C275").Value
-If B275 = C275 Then
-Range("D275").Value = "OK"
-Else
-Range("D275").Value = "NG"
-End If
-End Function
-
-Function test_xlPageBreakPartial(ByRef num)
-Range("A276").Clear
-Range("B276").Clear
-Range("C276").Clear
-Range("D276").Clear
-Range("A276").Value = "xlPageBreakPartial"
-Range("B276").Value = 2
-Range("C276").Value = num
-B276 = Range("B276").Value
-C276 = Range("C276").Value
-If B276 = C276 Then
-Range("D276").Value = "OK"
-Else
-Range("D276").Value = "NG"
-End If
-End Function
-
-Function test_xlLandscape(ByRef num)
-Range("A277").Clear
-Range("B277").Clear
-Range("C277").Clear
-Range("D277").Clear
-Range("A277").Value = "xlLandscape"
-Range("B277").Value = 2
-Range("C277").Value = num
-B277 = Range("B277").Value
-C277 = Range("C277").Value
-If B277 = C277 Then
-Range("D277").Value = "OK"
-Else
-Range("D277").Value = "NG"
-End If
-End Function
-
-Function test_xlPortrait(ByRef num)
-Range("A278").Clear
-Range("B278").Clear
-Range("C278").Clear
-Range("D278").Clear
-Range("A278").Value = "xlPortrait"
-Range("B278").Value = 1
-Range("C278").Value = num
-B278 = Range("B278").Value
-C278 = Range("C278").Value
-If B278 = C278 Then
-Range("D278").Value = "OK"
-Else
-Range("D278").Value = "NG"
-End If
-End Function
-
-Function test_xlPaper10x14(ByRef num)
-Range("A279").Clear
-Range("B279").Clear
-Range("C279").Clear
-Range("D279").Clear
-Range("A279").Value = "xlPaper10x14"
-Range("B279").Value = 16
-Range("C279").Value = num
-B279 = Range("B279").Value
-C279 = Range("C279").Value
-If B279 = C279 Then
-Range("D279").Value = "OK"
-Else
-Range("D279").Value = "NG"
-End If
-End Function
-
-Function test_xlPaper11x17(ByRef num)
-Range("A280").Clear
-Range("B280").Clear
-Range("C280").Clear
-Range("D280").Clear
-Range("A280").Value = "xlPaper11x17"
-Range("B280").Value = 17
-Range("C280").Value = num
-B280 = Range("B280").Value
-C280 = Range("C280").Value
-If B280 = C280 Then
-Range("D280").Value = "OK"
-Else
-Range("D280").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperA3(ByRef num)
-Range("A281").Clear
-Range("B281").Clear
-Range("C281").Clear
-Range("D281").Clear
-Range("A281").Value = "xlPaperA3"
-Range("B281").Value = 8
-Range("C281").Value = num
-B281 = Range("B281").Value
-C281 = Range("C281").Value
-If B281 = C281 Then
-Range("D281").Value = "OK"
-Else
-Range("D281").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperA4Small(ByRef num)
-Range("A282").Clear
-Range("B282").Clear
-Range("C282").Clear
-Range("D282").Clear
-Range("A282").Value = "xlPaperA4Small"
-Range("B282").Value = 9
-Range("C282").Value = num
-B282 = Range("B282").Value
-C282 = Range("C282").Value
-If B282 = C282 Then
-Range("D282").Value = "OK"
-Else
-Range("D282").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperA5(ByRef num)
-Range("A283").Clear
-Range("B283").Clear
-Range("C283").Clear
-Range("D283").Clear
-Range("A283").Value = "xlPaperA5"
-Range("B283").Value = 10
-Range("C283").Value = num
-B283 = Range("B283").Value
-C283 = Range("C283").Value
-If B283 = C283 Then
-Range("D283").Value = "OK"
-Else
-Range("D283").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperB4(ByRef num)
-Range("A284").Clear
-Range("B284").Clear
-Range("C284").Clear
-Range("D284").Clear
-Range("A284").Value = "xlPaperB4"
-Range("B284").Value = 12
-Range("C284").Value = num
-B284 = Range("B284").Value
-C284 = Range("C284").Value
-If B284 = C284 Then
-Range("D284").Value = "OK"
-Else
-Range("D284").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperB5(ByRef num)
-Range("A285").Clear
-Range("B285").Clear
-Range("C285").Clear
-Range("D285").Clear
-Range("A285").Value = "xlPaperB5"
-Range("B285").Value = 13
-Range("C285").Value = num
-B285 = Range("B285").Value
-C285 = Range("C285").Value
-If B285 = C285 Then
-Range("D285").Value = "OK"
-Else
-Range("D285").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperCsheet(ByRef num)
-Range("A286").Clear
-Range("B286").Clear
-Range("C286").Clear
-Range("D286").Clear
-Range("A286").Value = "xlPaperCsheet"
-Range("B286").Value = 24
-Range("C286").Value = num
-B286 = Range("B286").Value
-C286 = Range("C286").Value
-If B286 = C286 Then
-Range("D286").Value = "OK"
-Else
-Range("D286").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperDsheet(ByRef num)
-Range("A287").Clear
-Range("B287").Clear
-Range("C287").Clear
-Range("D287").Clear
-Range("A287").Value = "xlPaperDsheet"
-Range("B287").Value = 25
-Range("C287").Value = num
-B287 = Range("B287").Value
-C287 = Range("C287").Value
-If B287 = C287 Then
-Range("D287").Value = "OK"
-Else
-Range("D287").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelope10(ByRef num)
-Range("A288").Clear
-Range("B288").Clear
-Range("C288").Clear
-Range("D288").Clear
-Range("A288").Value = "xlPaperEnvelope10"
-Range("B288").Value = 20
-Range("C288").Value = num
-B288 = Range("B288").Value
-C288 = Range("C288").Value
-If B288 = C288 Then
-Range("D288").Value = "OK"
-Else
-Range("D288").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelope11(ByRef num)
-Range("A289").Clear
-Range("B289").Clear
-Range("C289").Clear
-Range("D289").Clear
-Range("A289").Value = "xlPaperEnvelope11"
-Range("B289").Value = 21
-Range("C289").Value = num
-B289 = Range("B289").Value
-C289 = Range("C289").Value
-If B289 = C289 Then
-Range("D289").Value = "OK"
-Else
-Range("D289").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelope12(ByRef num)
-Range("A290").Clear
-Range("B290").Clear
-Range("C290").Clear
-Range("D290").Clear
-Range("A290").Value = "xlPaperEnvelope12"
-Range("B290").Value = 22
-Range("C290").Value = num
-B290 = Range("B290").Value
-C290 = Range("C290").Value
-If B290 = C290 Then
-Range("D290").Value = "OK"
-Else
-Range("D290").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelope14(ByRef num)
-Range("A291").Clear
-Range("B291").Clear
-Range("C291").Clear
-Range("D291").Clear
-Range("A291").Value = "xlPaperEnvelope14"
-Range("B291").Value = 23
-Range("C291").Value = num
-B291 = Range("B291").Value
-C291 = Range("C291").Value
-If B291 = C291 Then
-Range("D291").Value = "OK"
-Else
-Range("D291").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelope9(ByRef num)
-Range("A292").Clear
-Range("B292").Clear
-Range("C292").Clear
-Range("D292").Clear
-Range("A292").Value = "xlPaperEnvelope9"
-Range("B292").Value = 19
-Range("C292").Value = num
-B292 = Range("B292").Value
-C292 = Range("C292").Value
-If B292 = C292 Then
-Range("D292").Value = "OK"
-Else
-Range("D292").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeB4(ByRef num)
-Range("A293").Clear
-Range("B293").Clear
-Range("C293").Clear
-Range("D293").Clear
-Range("A293").Value = "xlPaperEnvelopeB4"
-Range("B293").Value = 33
-Range("C293").Value = num
-B293 = Range("B293").Value
-C293 = Range("C293").Value
-If B293 = C293 Then
-Range("D293").Value = "OK"
-Else
-Range("D293").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeB5(ByRef num)
-Range("A294").Clear
-Range("B294").Clear
-Range("C294").Clear
-Range("D294").Clear
-Range("A294").Value = "xlPaperEnvelopeB5"
-Range("B294").Value = 34
-Range("C294").Value = num
-B294 = Range("B294").Value
-C294 = Range("C294").Value
-If B294 = C294 Then
-Range("D294").Value = "OK"
-Else
-Range("D294").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeB6(ByRef num)
-Range("A295").Clear
-Range("B295").Clear
-Range("C295").Clear
-Range("D295").Clear
-Range("A295").Value = "xlPaperEnvelopeB6"
-Range("B295").Value = 35
-Range("C295").Value = num
-B295 = Range("B295").Value
-C295 = Range("C295").Value
-If B295 = C295 Then
-Range("D295").Value = "OK"
-Else
-Range("D295").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeC3(ByRef num)
-Range("A296").Clear
-Range("B296").Clear
-Range("C296").Clear
-Range("D296").Clear
-Range("A296").Value = "xlPaperEnvelopeC3"
-Range("B296").Value = 29
-Range("C296").Value = num
-B296 = Range("B296").Value
-C296 = Range("C296").Value
-If B296 = C296 Then
-Range("D296").Value = "OK"
-Else
-Range("D296").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeC4(ByRef num)
-Range("A297").Clear
-Range("B297").Clear
-Range("C297").Clear
-Range("D297").Clear
-Range("A297").Value = "xlPaperEnvelopeC4"
-Range("B297").Value = 30
-Range("C297").Value = num
-B297 = Range("B297").Value
-C297 = Range("C297").Value
-If B297 = C297 Then
-Range("D297").Value = "OK"
-Else
-Range("D297").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeC5(ByRef num)
-Range("A298").Clear
-Range("B298").Clear
-Range("C298").Clear
-Range("D298").Clear
-Range("A298").Value = "xlPaperEnvelopeC5"
-Range("B298").Value = 28
-Range("C298").Value = num
-B298 = Range("B298").Value
-C298 = Range("C298").Value
-If B298 = C298 Then
-Range("D298").Value = "OK"
-Else
-Range("D298").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeC6(ByRef num)
-Range("A299").Clear
-Range("B299").Clear
-Range("C299").Clear
-Range("D299").Clear
-Range("A299").Value = "xlPaperEnvelopeC6"
-Range("B299").Value = 31
-Range("C299").Value = num
-B299 = Range("B299").Value
-C299 = Range("C299").Value
-If B299 = C299 Then
-Range("D299").Value = "OK"
-Else
-Range("D299").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeC65(ByRef num)
-Range("A300").Clear
-Range("B300").Clear
-Range("C300").Clear
-Range("D300").Clear
-Range("A300").Value = "xlPaperEnvelopeC65"
-Range("B300").Value = 32
-Range("C300").Value = num
-B300 = Range("B300").Value
-C300 = Range("C300").Value
-If B300 = C300 Then
-Range("D300").Value = "OK"
-Else
-Range("D300").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeDL(ByRef num)
-Range("A301").Clear
-Range("B301").Clear
-Range("C301").Clear
-Range("D301").Clear
-Range("A301").Value = "xlPaperEnvelopeDL"
-Range("B301").Value = 27
-Range("C301").Value = num
-B301 = Range("B301").Value
-C301 = Range("C301").Value
-If B301 = C301 Then
-Range("D301").Value = "OK"
-Else
-Range("D301").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeItaly(ByRef num)
-Range("A302").Clear
-Range("B302").Clear
-Range("C302").Clear
-Range("D302").Clear
-Range("A302").Value = "xlPaperEnvelopeItaly"
-Range("B302").Value = 36
-Range("C302").Value = num
-B302 = Range("B302").Value
-C302 = Range("C302").Value
-If B302 = C302 Then
-Range("D302").Value = "OK"
-Else
-Range("D302").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopeMonarch(ByRef num)
-Range("A303").Clear
-Range("B303").Clear
-Range("C303").Clear
-Range("D303").Clear
-Range("A303").Value = "xlPaperEnvelopeMonarch"
-Range("B303").Value = 37
-Range("C303").Value = num
-B303 = Range("B303").Value
-C303 = Range("C303").Value
-If B303 = C303 Then
-Range("D303").Value = "OK"
-Else
-Range("D303").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEnvelopePersonal(ByRef num)
-Range("A304").Clear
-Range("B304").Clear
-Range("C304").Clear
-Range("D304").Clear
-Range("A304").Value = "xlPaperEnvelopePersonal"
-Range("B304").Value = 38
-Range("C304").Value = num
-B304 = Range("B304").Value
-C304 = Range("C304").Value
-If B304 = C304 Then
-Range("D304").Value = "OK"
-Else
-Range("D304").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperEsheet(ByRef num)
-Range("A305").Clear
-Range("B305").Clear
-Range("C305").Clear
-Range("D305").Clear
-Range("A305").Value = "xlPaperEsheet"
-Range("B305").Value = 26
-Range("C305").Value = num
-B305 = Range("B305").Value
-C305 = Range("C305").Value
-If B305 = C305 Then
-Range("D305").Value = "OK"
-Else
-Range("D305").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperExective(ByRef num)
-Range("A306").Clear
-Range("B306").Clear
-Range("C306").Clear
-Range("D306").Clear
-Range("A306").Value = "xlPaperExective"
-Range("B306").Value = 7
-Range("C306").Value = num
-B306 = Range("B306").Value
-C306 = Range("C306").Value
-If B306 = C306 Then
-Range("D306").Value = "OK"
-Else
-Range("D306").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperFanfoldLegalGerman(ByRef num)
-Range("A307").Clear
-Range("B307").Clear
-Range("C307").Clear
-Range("D307").Clear
-Range("A307").Value = "xlPaperFanfoldLegalGerman"
-Range("B307").Value = 41
-Range("C307").Value = num
-B307 = Range("B307").Value
-C307 = Range("C307").Value
-If B307 = C307 Then
-Range("D307").Value = "OK"
-Else
-Range("D307").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperFanfoldStdGerman(ByRef num)
-Range("A308").Clear
-Range("B308").Clear
-Range("C308").Clear
-Range("D308").Clear
-Range("A308").Value = "xlPaperFanfoldStdGerman"
-Range("B308").Value = 40
-Range("C308").Value = num
-B308 = Range("B308").Value
-C308 = Range("C308").Value
-If B308 = C308 Then
-Range("D308").Value = "OK"
-Else
-Range("D308").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperFanfoldUS(ByRef num)
-Range("A309").Clear
-Range("B309").Clear
-Range("C309").Clear
-Range("D309").Clear
-Range("A309").Value = "xlPaperFanfoldUS"
-Range("B309").Value = 39
-Range("C309").Value = num
-B309 = Range("B309").Value
-C309 = Range("C309").Value
-If B309 = C309 Then
-Range("D309").Value = "OK"
-Else
-Range("D309").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperFolio(ByRef num)
-Range("A310").Clear
-Range("B310").Clear
-Range("C310").Clear
-Range("D310").Clear
-Range("A310").Value = "xlPaperFolio"
-Range("B310").Value = 14
-Range("C310").Value = num
-B310 = Range("B310").Value
-C310 = Range("C310").Value
-If B310 = C310 Then
-Range("D310").Value = "OK"
-Else
-Range("D310").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperLedger(ByRef num)
-Range("A311").Clear
-Range("B311").Clear
-Range("C311").Clear
-Range("D311").Clear
-Range("A311").Value = "xlPaperLedger"
-Range("B311").Value = 4
-Range("C311").Value = num
-B311 = Range("B311").Value
-C311 = Range("C311").Value
-If B311 = C311 Then
-Range("D311").Value = "OK"
-Else
-Range("D311").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperLegal(ByRef num)
-Range("A312").Clear
-Range("B312").Clear
-Range("C312").Clear
-Range("D312").Clear
-Range("A312").Value = "xlPaperLegal"
-Range("B312").Value = 5
-Range("C312").Value = num
-B312 = Range("B312").Value
-C312 = Range("C312").Value
-If B312 = C312 Then
-Range("D312").Value = "OK"
-Else
-Range("D312").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperLetter(ByRef num)
-Range("A313").Clear
-Range("B313").Clear
-Range("C313").Clear
-Range("D313").Clear
-Range("A313").Value = "xlPaperLetter"
-Range("B313").Value = 1
-Range("C313").Value = num
-B313 = Range("B313").Value
-C313 = Range("C313").Value
-If B313 = C313 Then
-Range("D313").Value = "OK"
-Else
-Range("D313").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperLetterSmall(ByRef num)
-Range("A314").Clear
-Range("B314").Clear
-Range("C314").Clear
-Range("D314").Clear
-Range("A314").Value = "xlPaperLetterSmall"
-Range("B314").Value = 2
-Range("C314").Value = num
-B314 = Range("B314").Value
-C314 = Range("C314").Value
-If B314 = C314 Then
-Range("D314").Value = "OK"
-Else
-Range("D314").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperNote(ByRef num)
-Range("A315").Clear
-Range("B315").Clear
-Range("C315").Clear
-Range("D315").Clear
-Range("A315").Value = "xlPaperNote"
-Range("B315").Value = 18
-Range("C315").Value = num
-B315 = Range("B315").Value
-C315 = Range("C315").Value
-If B315 = C315 Then
-Range("D315").Value = "OK"
-Else
-Range("D315").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperQuarto(ByRef num)
-Range("A316").Clear
-Range("B316").Clear
-Range("C316").Clear
-Range("D316").Clear
-Range("A316").Value = "xlPaperQuarto"
-Range("B316").Value = 15
-Range("C316").Value = num
-B316 = Range("B316").Value
-C316 = Range("C316").Value
-If B316 = C316 Then
-Range("D316").Value = "OK"
-Else
-Range("D316").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperStatement(ByRef num)
-Range("A317").Clear
-Range("B317").Clear
-Range("C317").Clear
-Range("D317").Clear
-Range("A317").Value = "xlPaperStatement"
-Range("B317").Value = 6
-Range("C317").Value = num
-B317 = Range("B317").Value
-C317 = Range("C317").Value
-If B317 = C317 Then
-Range("D317").Value = "OK"
-Else
-Range("D317").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperTabloid(ByRef num)
-Range("A318").Clear
-Range("B318").Clear
-Range("C318").Clear
-Range("D318").Clear
-Range("A318").Value = "xlPaperTabloid"
-Range("B318").Value = 3
-Range("C318").Value = num
-B318 = Range("B318").Value
-C318 = Range("C318").Value
-If B318 = C318 Then
-Range("D318").Value = "OK"
-Else
-Range("D318").Value = "NG"
-End If
-End Function
-
-Function test_xlPaperUser(ByRef num)
-Range("A319").Clear
-Range("B319").Clear
-Range("C319").Clear
-Range("D319").Clear
-Range("A319").Value = "xlPaperUser"
-Range("B319").Value = 256
-Range("C319").Value = num
-B319 = Range("B319").Value
-C319 = Range("C319").Value
-If B319 = C319 Then
-Range("D319").Value = "OK"
-Else
-Range("D319").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeBigInt(ByRef num)
-Range("A320").Clear
-Range("B320").Clear
-Range("C320").Clear
-Range("D320").Clear
-Range("A320").Value = "xlParameterTypeBigInt"
-Range("B320").Value = -5
-Range("C320").Value = num
-B320 = Range("B320").Value
-C320 = Range("C320").Value
-If B320 = C320 Then
-Range("D320").Value = "OK"
-Else
-Range("D320").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeBinary(ByRef num)
-Range("A321").Clear
-Range("B321").Clear
-Range("C321").Clear
-Range("D321").Clear
-Range("A321").Value = "xlParameterTypeBinary"
-Range("B321").Value = -2
-Range("C321").Value = num
-B321 = Range("B321").Value
-C321 = Range("C321").Value
-If B321 = C321 Then
-Range("D321").Value = "OK"
-Else
-Range("D321").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeBit(ByRef num)
-Range("A322").Clear
-Range("B322").Clear
-Range("C322").Clear
-Range("D322").Clear
-Range("A322").Value = "xlParameterTypeBit"
-Range("B322").Value = -7
-Range("C322").Value = num
-B322 = Range("B322").Value
-C322 = Range("C322").Value
-If B322 = C322 Then
-Range("D322").Value = "OK"
-Else
-Range("D322").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeChar(ByRef num)
-Range("A323").Clear
-Range("B323").Clear
-Range("C323").Clear
-Range("D323").Clear
-Range("A323").Value = "xlParameterTypeChar"
-Range("B323").Value = 1
-Range("C323").Value = num
-B323 = Range("B323").Value
-C323 = Range("C323").Value
-If B323 = C323 Then
-Range("D323").Value = "OK"
-Else
-Range("D323").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeData(ByRef num)
-Range("A324").Clear
-Range("B324").Clear
-Range("C324").Clear
-Range("D324").Clear
-Range("A324").Value = "xlParameterTypeData"
-Range("B324").Value = 9
-Range("C324").Value = num
-B324 = Range("B324").Value
-C324 = Range("C324").Value
-If B324 = C324 Then
-Range("D324").Value = "OK"
-Else
-Range("D324").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeDecimal(ByRef num)
-Range("A325").Clear
-Range("B325").Clear
-Range("C325").Clear
-Range("D325").Clear
-Range("A325").Value = "xlParameterTypeDecimal"
-Range("B325").Value = 3
-Range("C325").Value = num
-B325 = Range("B325").Value
-C325 = Range("C325").Value
-If B325 = C325 Then
-Range("D325").Value = "OK"
-Else
-Range("D325").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeDouble(ByRef num)
-Range("A326").Clear
-Range("B326").Clear
-Range("C326").Clear
-Range("D326").Clear
-Range("A326").Value = "xlParameterTypeDouble"
-Range("B326").Value = 8
-Range("C326").Value = num
-B326 = Range("B326").Value
-C326 = Range("C326").Value
-If B326 = C326 Then
-Range("D326").Value = "OK"
-Else
-Range("D326").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeFloat(ByRef num)
-Range("A327").Clear
-Range("B327").Clear
-Range("C327").Clear
-Range("D327").Clear
-Range("A327").Value = "xlParameterTypeFloat"
-Range("B327").Value = 6
-Range("C327").Value = num
-B327 = Range("B327").Value
-C327 = Range("C327").Value
-If B327 = C327 Then
-Range("D327").Value = "OK"
-Else
-Range("D327").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeInteger(ByRef num)
-Range("A328").Clear
-Range("B328").Clear
-Range("C328").Clear
-Range("D328").Clear
-Range("A328").Value = "xlParameterTypeInteger"
-Range("B328").Value = 4
-Range("C328").Value = num
-B328 = Range("B328").Value
-C328 = Range("C328").Value
-If B328 = C328 Then
-Range("D328").Value = "OK"
-Else
-Range("D328").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeLongVarBinary(ByRef num)
-Range("A329").Clear
-Range("B329").Clear
-Range("C329").Clear
-Range("D329").Clear
-Range("A329").Value = "xlParameterTypeLongVarBinary"
-Range("B329").Value = -4
-Range("C329").Value = num
-B329 = Range("B329").Value
-C329 = Range("C329").Value
-If B329 = C329 Then
-Range("D329").Value = "OK"
-Else
-Range("D329").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeLongVarChar(ByRef num)
-Range("A330").Clear
-Range("B330").Clear
-Range("C330").Clear
-Range("D330").Clear
-Range("A330").Value = "xlParameterTypeLongVarChar"
-Range("B330").Value = -1
-Range("C330").Value = num
-B330 = Range("B330").Value
-C330 = Range("C330").Value
-If B330 = C330 Then
-Range("D330").Value = "OK"
-Else
-Range("D330").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeNumeric(ByRef num)
-Range("A331").Clear
-Range("B331").Clear
-Range("C331").Clear
-Range("D331").Clear
-Range("A331").Value = "xlParameterTypeNumeric"
-Range("B331").Value = 2
-Range("C331").Value = num
-B331 = Range("B331").Value
-C331 = Range("C331").Value
-If B331 = C331 Then
-Range("D331").Value = "OK"
-Else
-Range("D331").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeReal(ByRef num)
-Range("A332").Clear
-Range("B332").Clear
-Range("C332").Clear
-Range("D332").Clear
-Range("A332").Value = "xlParameterTypeReal"
-Range("B332").Value = 7
-Range("C332").Value = num
-B332 = Range("B332").Value
-C332 = Range("C332").Value
-If B332 = C332 Then
-Range("D332").Value = "OK"
-Else
-Range("D332").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeSmallInt(ByRef num)
-Range("A333").Clear
-Range("B333").Clear
-Range("C333").Clear
-Range("D333").Clear
-Range("A333").Value = "xlParameterTypeSmallInt"
-Range("B333").Value = 5
-Range("C333").Value = num
-B333 = Range("B333").Value
-C333 = Range("C333").Value
-If B333 = C333 Then
-Range("D333").Value = "OK"
-Else
-Range("D333").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeTime(ByRef num)
-Range("A334").Clear
-Range("B334").Clear
-Range("C334").Clear
-Range("D334").Clear
-Range("A334").Value = "xlParameterTypeTime"
-Range("B334").Value = 10
-Range("C334").Value = num
-B334 = Range("B334").Value
-C334 = Range("C334").Value
-If B334 = C334 Then
-Range("D334").Value = "OK"
-Else
-Range("D334").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeTimestamp(ByRef num)
-Range("A335").Clear
-Range("B335").Clear
-Range("C335").Clear
-Range("D335").Clear
-Range("A335").Value = "xlParameterTypeTimestamp"
-Range("B335").Value = 11
-Range("C335").Value = num
-B335 = Range("B335").Value
-C335 = Range("C335").Value
-If B335 = C335 Then
-Range("D335").Value = "OK"
-Else
-Range("D335").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeTinyInt(ByRef num)
-Range("A336").Clear
-Range("B336").Clear
-Range("C336").Clear
-Range("D336").Clear
-Range("A336").Value = "xlParameterTypeTinyInt"
-Range("B336").Value = -6
-Range("C336").Value = num
-B336 = Range("B336").Value
-C336 = Range("C336").Value
-If B336 = C336 Then
-Range("D336").Value = "OK"
-Else
-Range("D336").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeUnknown(ByRef num)
-Range("A337").Clear
-Range("B337").Clear
-Range("C337").Clear
-Range("D337").Clear
-Range("A337").Value = "xlParameterTypeUnknown"
-Range("B337").Value = 0
-Range("C337").Value = num
-B337 = Range("B337").Value
-C337 = Range("C337").Value
-If B337 = C337 Then
-Range("D337").Value = "OK"
-Else
-Range("D337").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeVarBinary(ByRef num)
-Range("A338").Clear
-Range("B338").Clear
-Range("C338").Clear
-Range("D338").Clear
-Range("A338").Value = "xlParameterTypeVarBinary"
-Range("B338").Value = -3
-Range("C338").Value = num
-B338 = Range("B338").Value
-C338 = Range("C338").Value
-If B338 = C338 Then
-Range("D338").Value = "OK"
-Else
-Range("D338").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeVarChar(ByRef num)
-Range("A339").Clear
-Range("B339").Clear
-Range("C339").Clear
-Range("D339").Clear
-Range("A339").Value = "xlParameterTypeVarChar"
-Range("B339").Value = 12
-Range("C339").Value = num
-B339 = Range("B339").Value
-C339 = Range("C339").Value
-If B339 = C339 Then
-Range("D339").Value = "OK"
-Else
-Range("D339").Value = "NG"
-End If
-End Function
-
-Function test_xlParameterTypeWChar(ByRef num)
-Range("A340").Clear
-Range("B340").Clear
-Range("C340").Clear
-Range("D340").Clear
-Range("A340").Value = "xlParameterTypeWChar"
-Range("B340").Value = -8
-Range("C340").Value = num
-B340 = Range("B340").Value
-C340 = Range("C340").Value
-If B340 = C340 Then
-Range("D340").Value = "OK"
-Else
-Range("D340").Value = "NG"
-End If
-End Function
-
-Function test_xlConstant(ByRef num)
-Range("A341").Clear
-Range("B341").Clear
-Range("C341").Clear
-Range("D341").Clear
-Range("A341").Value = "xlConstant"
-Range("B341").Value = 1
-Range("C341").Value = num
-B341 = Range("B341").Value
-C341 = Range("C341").Value
-If B341 = C341 Then
-Range("D341").Value = "OK"
-Else
-Range("D341").Value = "NG"
-End If
-End Function
-
-Function test_xlPrompt(ByRef num)
-Range("A342").Clear
-Range("B342").Clear
-Range("C342").Clear
-Range("D342").Clear
-Range("A342").Value = "xlPrompt"
-Range("B342").Value = 0
-Range("C342").Value = num
-B342 = Range("B342").Value
-C342 = Range("C342").Value
-If B342 = C342 Then
-Range("D342").Value = "OK"
-Else
-Range("D342").Value = "NG"
-End If
-End Function
-
-Function test_xlRange(ByRef num)
-Range("A343").Clear
-Range("B343").Clear
-Range("C343").Clear
-Range("D343").Clear
-Range("A343").Value = "xlRange"
-Range("B343").Value = 2
-Range("C343").Value = num
-B343 = Range("B343").Value
-C343 = Range("C343").Value
-If B343 = C343 Then
-Range("D343").Value = "OK"
-Else
-Range("D343").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteSpecialOperationAdd(ByRef num)
-Range("A344").Clear
-Range("B344").Clear
-Range("C344").Clear
-Range("D344").Clear
-Range("A344").Value = "xlPasteSpecialOperationAdd"
-Range("B344").Value = 2
-Range("C344").Value = num
-B344 = Range("B344").Value
-C344 = Range("C344").Value
-If B344 = C344 Then
-Range("D344").Value = "OK"
-Else
-Range("D344").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteSpecialOperationDivide(ByRef num)
-Range("A345").Clear
-Range("B345").Clear
-Range("C345").Clear
-Range("D345").Clear
-Range("A345").Value = "xlPasteSpecialOperationDivide"
-Range("B345").Value = 5
-Range("C345").Value = num
-B345 = Range("B345").Value
-C345 = Range("C345").Value
-If B345 = C345 Then
-Range("D345").Value = "OK"
-Else
-Range("D345").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteSpecialOperationMultiply(ByRef num)
-Range("A346").Clear
-Range("B346").Clear
-Range("C346").Clear
-Range("D346").Clear
-Range("A346").Value = "xlPasteSpecialOperationMultiply"
-Range("B346").Value = 4
-Range("C346").Value = num
-B346 = Range("B346").Value
-C346 = Range("C346").Value
-If B346 = C346 Then
-Range("D346").Value = "OK"
-Else
-Range("D346").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteSpecialOperationNone(ByRef num)
-Range("A347").Clear
-Range("B347").Clear
-Range("C347").Clear
-Range("D347").Clear
-Range("A347").Value = "xlPasteSpecialOperationNone"
-Range("B347").Value = -4142
-Range("C347").Value = num
-B347 = Range("B347").Value
-C347 = Range("C347").Value
-If B347 = C347 Then
-Range("D347").Value = "OK"
-Else
-Range("D347").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteSpecialOperationSubstract(ByRef num)
-Range("A348").Clear
-Range("B348").Clear
-Range("C348").Clear
-Range("D348").Clear
-Range("A348").Value = "xlPasteSpecialOperationSubstract"
-Range("B348").Value = 3
-Range("C348").Value = num
-B348 = Range("B348").Value
-C348 = Range("C348").Value
-If B348 = C348 Then
-Range("D348").Value = "OK"
-Else
-Range("D348").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteAll(ByRef num)
-Range("A349").Clear
-Range("B349").Clear
-Range("C349").Clear
-Range("D349").Clear
-Range("A349").Value = "xlPasteAll"
-Range("B349").Value = -4104
-Range("C349").Value = num
-B349 = Range("B349").Value
-C349 = Range("C349").Value
-If B349 = C349 Then
-Range("D349").Value = "OK"
-Else
-Range("D349").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteAllExceptBorders(ByRef num)
-Range("A350").Clear
-Range("B350").Clear
-Range("C350").Clear
-Range("D350").Clear
-Range("A350").Value = "xlPasteAllExceptBorders"
-Range("B350").Value = 7
-Range("C350").Value = num
-B350 = Range("B350").Value
-C350 = Range("C350").Value
-If B350 = C350 Then
-Range("D350").Value = "OK"
-Else
-Range("D350").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteAllColumnWidths(ByRef num)
-Range("A351").Clear
-Range("B351").Clear
-Range("C351").Clear
-Range("D351").Clear
-Range("A351").Value = "xlPasteAllColumnWidths"
-Range("B351").Value = 8
-Range("C351").Value = num
-B351 = Range("B351").Value
-C351 = Range("C351").Value
-If B351 = C351 Then
-Range("D351").Value = "OK"
-Else
-Range("D351").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteComments(ByRef num)
-Range("A352").Clear
-Range("B352").Clear
-Range("C352").Clear
-Range("D352").Clear
-Range("A352").Value = "xlPasteComments"
-Range("B352").Value = -4144
-Range("C352").Value = num
-B352 = Range("B352").Value
-C352 = Range("C352").Value
-If B352 = C352 Then
-Range("D352").Value = "OK"
-Else
-Range("D352").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteFormats(ByRef num)
-Range("A353").Clear
-Range("B353").Clear
-Range("C353").Clear
-Range("D353").Clear
-Range("A353").Value = "xlPasteFormats"
-Range("B353").Value = -4122
-Range("C353").Value = num
-B353 = Range("B353").Value
-C353 = Range("C353").Value
-If B353 = C353 Then
-Range("D353").Value = "OK"
-Else
-Range("D353").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteFormulas(ByRef num)
-Range("A354").Clear
-Range("B354").Clear
-Range("C354").Clear
-Range("D354").Clear
-Range("A354").Value = "xlPasteFormulas"
-Range("B354").Value = -4123
-Range("C354").Value = num
-B354 = Range("B354").Value
-C354 = Range("C354").Value
-If B354 = C354 Then
-Range("D354").Value = "OK"
-Else
-Range("D354").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteFormulasAndNumberFormats(ByRef num)
-Range("A355").Clear
-Range("B355").Clear
-Range("C355").Clear
-Range("D355").Clear
-Range("A355").Value = "xlPasteFormulasAndNumberFormats"
-Range("B355").Value = 11
-Range("C355").Value = num
-B355 = Range("B355").Value
-C355 = Range("C355").Value
-If B355 = C355 Then
-Range("D355").Value = "OK"
-Else
-Range("D355").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteValidation(ByRef num)
-Range("A356").Clear
-Range("B356").Clear
-Range("C356").Clear
-Range("D356").Clear
-Range("A356").Value = "xlPasteValidation"
-Range("B356").Value = 6
-Range("C356").Value = num
-B356 = Range("B356").Value
-C356 = Range("C356").Value
-If B356 = C356 Then
-Range("D356").Value = "OK"
-Else
-Range("D356").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteValues(ByRef num)
-Range("A357").Clear
-Range("B357").Clear
-Range("C357").Clear
-Range("D357").Clear
-Range("A357").Value = "xlPasteValues"
-Range("B357").Value = -4163
-Range("C357").Value = num
-B357 = Range("B357").Value
-C357 = Range("C357").Value
-If B357 = C357 Then
-Range("D357").Value = "OK"
-Else
-Range("D357").Value = "NG"
-End If
-End Function
-
-Function test_xlPasteValuesAndNumberFormats(ByRef num)
-Range("A358").Clear
-Range("B358").Clear
-Range("C358").Clear
-Range("D358").Clear
-Range("A358").Value = "xlPasteValuesAndNumberFormats"
-Range("B358").Value = 12
-Range("C358").Value = num
-B358 = Range("B358").Value
-C358 = Range("C358").Value
-If B358 = C358 Then
-Range("D358").Value = "OK"
-Else
-Range("D358").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternAutomatic(ByRef num)
-Range("A359").Clear
-Range("B359").Clear
-Range("C359").Clear
-Range("D359").Clear
-Range("A359").Value = "xlPatternAutomatic"
-Range("B359").Value = -4105
-Range("C359").Value = num
-B359 = Range("B359").Value
-C359 = Range("C359").Value
-If B359 = C359 Then
-Range("D359").Value = "OK"
-Else
-Range("D359").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternChecker(ByRef num)
-Range("A360").Clear
-Range("B360").Clear
-Range("C360").Clear
-Range("D360").Clear
-Range("A360").Value = "xlPatternChecker"
-Range("B360").Value = 9
-Range("C360").Value = num
-B360 = Range("B360").Value
-C360 = Range("C360").Value
-If B360 = C360 Then
-Range("D360").Value = "OK"
-Else
-Range("D360").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternCrissCross(ByRef num)
-Range("A361").Clear
-Range("B361").Clear
-Range("C361").Clear
-Range("D361").Clear
-Range("A361").Value = "xlPatternCrissCross"
-Range("B361").Value = 16
-Range("C361").Value = num
-B361 = Range("B361").Value
-C361 = Range("C361").Value
-If B361 = C361 Then
-Range("D361").Value = "OK"
-Else
-Range("D361").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternDown(ByRef num)
-Range("A362").Clear
-Range("B362").Clear
-Range("C362").Clear
-Range("D362").Clear
-Range("A362").Value = "xlPatternDown"
-Range("B362").Value = -4121
-Range("C362").Value = num
-B362 = Range("B362").Value
-C362 = Range("C362").Value
-If B362 = C362 Then
-Range("D362").Value = "OK"
-Else
-Range("D362").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGray16(ByRef num)
-Range("A363").Clear
-Range("B363").Clear
-Range("C363").Clear
-Range("D363").Clear
-Range("A363").Value = "xlPatternGray16"
-Range("B363").Value = 17
-Range("C363").Value = num
-B363 = Range("B363").Value
-C363 = Range("C363").Value
-If B363 = C363 Then
-Range("D363").Value = "OK"
-Else
-Range("D363").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGray25(ByRef num)
-Range("A364").Clear
-Range("B364").Clear
-Range("C364").Clear
-Range("D364").Clear
-Range("A364").Value = "xlPatternGray25"
-Range("B364").Value = -4124
-Range("C364").Value = num
-B364 = Range("B364").Value
-C364 = Range("C364").Value
-If B364 = C364 Then
-Range("D364").Value = "OK"
-Else
-Range("D364").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGray50(ByRef num)
-Range("A365").Clear
-Range("B365").Clear
-Range("C365").Clear
-Range("D365").Clear
-Range("A365").Value = "xlPatternGray50"
-Range("B365").Value = -4125
-Range("C365").Value = num
-B365 = Range("B365").Value
-C365 = Range("C365").Value
-If B365 = C365 Then
-Range("D365").Value = "OK"
-Else
-Range("D365").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGray75(ByRef num)
-Range("A366").Clear
-Range("B366").Clear
-Range("C366").Clear
-Range("D366").Clear
-Range("A366").Value = "xlPatternGray75"
-Range("B366").Value = -4126
-Range("C366").Value = num
-B366 = Range("B366").Value
-C366 = Range("C366").Value
-If B366 = C366 Then
-Range("D366").Value = "OK"
-Else
-Range("D366").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGray8(ByRef num)
-Range("A367").Clear
-Range("B367").Clear
-Range("C367").Clear
-Range("D367").Clear
-Range("A367").Value = "xlPatternGray8"
-Range("B367").Value = 18
-Range("C367").Value = num
-B367 = Range("B367").Value
-C367 = Range("C367").Value
-If B367 = C367 Then
-Range("D367").Value = "OK"
-Else
-Range("D367").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternGrid(ByRef num)
-Range("A368").Clear
-Range("B368").Clear
-Range("C368").Clear
-Range("D368").Clear
-Range("A368").Value = "xlPatternGrid"
-Range("B368").Value = 15
-Range("C368").Value = num
-B368 = Range("B368").Value
-C368 = Range("C368").Value
-If B368 = C368 Then
-Range("D368").Value = "OK"
-Else
-Range("D368").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternHorizontal(ByRef num)
-Range("A369").Clear
-Range("B369").Clear
-Range("C369").Clear
-Range("D369").Clear
-Range("A369").Value = "xlPatternHorizontal"
-Range("B369").Value = -4128
-Range("C369").Value = num
-B369 = Range("B369").Value
-C369 = Range("C369").Value
-If B369 = C369 Then
-Range("D369").Value = "OK"
-Else
-Range("D369").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternLightDown(ByRef num)
-Range("A370").Clear
-Range("B370").Clear
-Range("C370").Clear
-Range("D370").Clear
-Range("A370").Value = "xlPatternLightDown"
-Range("B370").Value = 13
-Range("C370").Value = num
-B370 = Range("B370").Value
-C370 = Range("C370").Value
-If B370 = C370 Then
-Range("D370").Value = "OK"
-Else
-Range("D370").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternLightHorizontal(ByRef num)
-Range("A371").Clear
-Range("B371").Clear
-Range("C371").Clear
-Range("D371").Clear
-Range("A371").Value = "xlPatternLightHorizontal"
-Range("B371").Value = 11
-Range("C371").Value = num
-B371 = Range("B371").Value
-C371 = Range("C371").Value
-If B371 = C371 Then
-Range("D371").Value = "OK"
-Else
-Range("D371").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternLightUp(ByRef num)
-Range("A372").Clear
-Range("B372").Clear
-Range("C372").Clear
-Range("D372").Clear
-Range("A372").Value = "xlPatternLightUp"
-Range("B372").Value = 14
-Range("C372").Value = num
-B372 = Range("B372").Value
-C372 = Range("C372").Value
-If B372 = C372 Then
-Range("D372").Value = "OK"
-Else
-Range("D372").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternLightVertical(ByRef num)
-Range("A373").Clear
-Range("B373").Clear
-Range("C373").Clear
-Range("D373").Clear
-Range("A373").Value = "xlPatternLightVertical"
-Range("B373").Value = 12
-Range("C373").Value = num
-B373 = Range("B373").Value
-C373 = Range("C373").Value
-If B373 = C373 Then
-Range("D373").Value = "OK"
-Else
-Range("D373").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternNone(ByRef num)
-Range("A374").Clear
-Range("B374").Clear
-Range("C374").Clear
-Range("D374").Clear
-Range("A374").Value = "xlPatternNone"
-Range("B374").Value = -4142
-Range("C374").Value = num
-B374 = Range("B374").Value
-C374 = Range("C374").Value
-If B374 = C374 Then
-Range("D374").Value = "OK"
-Else
-Range("D374").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternSemiGray75(ByRef num)
-Range("A375").Clear
-Range("B375").Clear
-Range("C375").Clear
-Range("D375").Clear
-Range("A375").Value = "xlPatternSemiGray75"
-Range("B375").Value = 10
-Range("C375").Value = num
-B375 = Range("B375").Value
-C375 = Range("C375").Value
-If B375 = C375 Then
-Range("D375").Value = "OK"
-Else
-Range("D375").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternSolid(ByRef num)
-Range("A376").Clear
-Range("B376").Clear
-Range("C376").Clear
-Range("D376").Clear
-Range("A376").Value = "xlPatternSolid"
-Range("B376").Value = 1
-Range("C376").Value = num
-B376 = Range("B376").Value
-C376 = Range("C376").Value
-If B376 = C376 Then
-Range("D376").Value = "OK"
-Else
-Range("D376").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternUp(ByRef num)
-Range("A377").Clear
-Range("B377").Clear
-Range("C377").Clear
-Range("D377").Clear
-Range("A377").Value = "xlPatternUp"
-Range("B377").Value = -4162
-Range("C377").Value = num
-B377 = Range("B377").Value
-C377 = Range("C377").Value
-If B377 = C377 Then
-Range("D377").Value = "OK"
-Else
-Range("D377").Value = "NG"
-End If
-End Function
-
-Function test_xlPatternVertical(ByRef num)
-Range("A378").Clear
-Range("B378").Clear
-Range("C378").Clear
-Range("D378").Clear
-Range("A378").Value = "xlPatternVertical"
-Range("B378").Value = -4166
-Range("C378").Value = num
-B378 = Range("B378").Value
-C378 = Range("C378").Value
-If B378 = C378 Then
-Range("D378").Value = "OK"
-Else
-Range("D378").Value = "NG"
-End If
-End Function
-
-Function test_XlPhoneticAlignCenter(ByRef num)
-Range("A379").Clear
-Range("B379").Clear
-Range("C379").Clear
-Range("D379").Clear
-Range("A379").Value = "XlPhoneticAlignCenter"
-Range("B379").Value = 2
-Range("C379").Value = num
-B379 = Range("B379").Value
-C379 = Range("C379").Value
-If B379 = C379 Then
-Range("D379").Value = "OK"
-Else
-Range("D379").Value = "NG"
-End If
-End Function
-
-Function test_XlPhoneticAlignDistributed(ByRef num)
-Range("A380").Clear
-Range("B380").Clear
-Range("C380").Clear
-Range("D380").Clear
-Range("A380").Value = "XlPhoneticAlignDistributed"
-Range("B380").Value = 3
-Range("C380").Value = num
-B380 = Range("B380").Value
-C380 = Range("C380").Value
-If B380 = C380 Then
-Range("D380").Value = "OK"
-Else
-Range("D380").Value = "NG"
-End If
-End Function
-
-Function test_XlPhoneticAlignLeft(ByRef num)
-Range("A381").Clear
-Range("B381").Clear
-Range("C381").Clear
-Range("D381").Clear
-Range("A381").Value = "XlPhoneticAlignLeft"
-Range("B381").Value = 1
-Range("C381").Value = num
-B381 = Range("B381").Value
-C381 = Range("C381").Value
-If B381 = C381 Then
-Range("D381").Value = "OK"
-Else
-Range("D381").Value = "NG"
-End If
-End Function
-
-Function test_XlPhoneticAlignNoControl(ByRef num)
-Range("A382").Clear
-Range("B382").Clear
-Range("C382").Clear
-Range("D382").Clear
-Range("A382").Value = "XlPhoneticAlignNoControl"
-Range("B382").Value = 0
-Range("C382").Value = num
-B382 = Range("B382").Value
-C382 = Range("C382").Value
-If B382 = C382 Then
-Range("D382").Value = "OK"
-Else
-Range("D382").Value = "NG"
-End If
-End Function
-
-Function test_xlPrinter(ByRef num)
-Range("A383").Clear
-Range("B383").Clear
-Range("C383").Clear
-Range("D383").Clear
-Range("A383").Value = "xlPrinter"
-Range("B383").Value = 2
-Range("C383").Value = num
-B383 = Range("B383").Value
-C383 = Range("C383").Value
-If B383 = C383 Then
-Range("D383").Value = "OK"
-Else
-Range("D383").Value = "NG"
-End If
-End Function
-
-Function test_xlScreen(ByRef num)
-Range("A384").Clear
-Range("B384").Clear
-Range("C384").Clear
-Range("D384").Clear
-Range("A384").Value = "xlScreen"
-Range("B384").Value = 1
-Range("C384").Value = num
-B384 = Range("B384").Value
-C384 = Range("C384").Value
-If B384 = C384 Then
-Range("D384").Value = "OK"
-Else
-Range("D384").Value = "NG"
-End If
-End Function
-
-Function test_xlBMP(ByRef num)
-Range("A385").Clear
-Range("B385").Clear
-Range("C385").Clear
-Range("D385").Clear
-Range("A385").Value = "xlBMP"
-Range("B385").Value = 1
-Range("C385").Value = num
-B385 = Range("B385").Value
-C385 = Range("C385").Value
-If B385 = C385 Then
-Range("D385").Value = "OK"
-Else
-Range("D385").Value = "NG"
-End If
-End Function
-
-Function test_xlCGM(ByRef num)
-Range("A386").Clear
-Range("B386").Clear
-Range("C386").Clear
-Range("D386").Clear
-Range("A386").Value = "xlCGM"
-Range("B386").Value = 7
-Range("C386").Value = num
-B386 = Range("B386").Value
-C386 = Range("C386").Value
-If B386 = C386 Then
-Range("D386").Value = "OK"
-Else
-Range("D386").Value = "NG"
-End If
-End Function
-
-Function test_xlDRW(ByRef num)
-Range("A387").Clear
-Range("B387").Clear
-Range("C387").Clear
-Range("D387").Clear
-Range("A387").Value = "xlDRW"
-Range("B387").Value = 4
-Range("C387").Value = num
-B387 = Range("B387").Value
-C387 = Range("C387").Value
-If B387 = C387 Then
-Range("D387").Value = "OK"
-Else
-Range("D387").Value = "NG"
-End If
-End Function
-
-Function test_xlDXF(ByRef num)
-Range("A388").Clear
-Range("B388").Clear
-Range("C388").Clear
-Range("D388").Clear
-Range("A388").Value = "xlDXF"
-Range("B388").Value = 5
-Range("C388").Value = num
-B388 = Range("B388").Value
-C388 = Range("C388").Value
-If B388 = C388 Then
-Range("D388").Value = "OK"
-Else
-Range("D388").Value = "NG"
-End If
-End Function
-
-Function test_xlEPS(ByRef num)
-Range("A389").Clear
-Range("B389").Clear
-Range("C389").Clear
-Range("D389").Clear
-Range("A389").Value = "xlEPS"
-Range("B389").Value = 8
-Range("C389").Value = num
-B389 = Range("B389").Value
-C389 = Range("C389").Value
-If B389 = C389 Then
-Range("D389").Value = "OK"
-Else
-Range("D389").Value = "NG"
-End If
-End Function
-
-Function test_xlHGL(ByRef num)
-Range("A390").Clear
-Range("B390").Clear
-Range("C390").Clear
-Range("D390").Clear
-Range("A390").Value = "xlHGL"
-Range("B390").Value = 6
-Range("C390").Value = num
-B390 = Range("B390").Value
-C390 = Range("C390").Value
-If B390 = C390 Then
-Range("D390").Value = "OK"
-Else
-Range("D390").Value = "NG"
-End If
-End Function
-
-Function test_xlPCT(ByRef num)
-Range("A391").Clear
-Range("B391").Clear
-Range("C391").Clear
-Range("D391").Clear
-Range("A391").Value = "xlPCT"
-Range("B391").Value = 13
-Range("C391").Value = num
-B391 = Range("B391").Value
-C391 = Range("C391").Value
-If B391 = C391 Then
-Range("D391").Value = "OK"
-Else
-Range("D391").Value = "NG"
-End If
-End Function
-
-Function test_xlPCX(ByRef num)
-Range("A392").Clear
-Range("B392").Clear
-Range("C392").Clear
-Range("D392").Clear
-Range("A392").Value = "xlPCX"
-Range("B392").Value = 10
-Range("C392").Value = num
-B392 = Range("B392").Value
-C392 = Range("C392").Value
-If B392 = C392 Then
-Range("D392").Value = "OK"
-Else
-Range("D392").Value = "NG"
-End If
-End Function
-
-Function test_xlPIC(ByRef num)
-Range("A393").Clear
-Range("B393").Clear
-Range("C393").Clear
-Range("D393").Clear
-Range("A393").Value = "xlPIC"
-Range("B393").Value = 11
-Range("C393").Value = num
-B393 = Range("B393").Value
-C393 = Range("C393").Value
-If B393 = C393 Then
-Range("D393").Value = "OK"
-Else
-Range("D393").Value = "NG"
-End If
-End Function
-
-Function test_xlPLT(ByRef num)
-Range("A394").Clear
-Range("B394").Clear
-Range("C394").Clear
-Range("D394").Clear
-Range("A394").Value = "xlPLT"
-Range("B394").Value = 12
-Range("C394").Value = num
-B394 = Range("B394").Value
-C394 = Range("C394").Value
-If B394 = C394 Then
-Range("D394").Value = "OK"
-Else
-Range("D394").Value = "NG"
-End If
-End Function
-
-Function test_xlTIF(ByRef num)
-Range("A395").Clear
-Range("B395").Clear
-Range("C395").Clear
-Range("D395").Clear
-Range("A395").Value = "xlTIF"
-Range("B395").Value = 9
-Range("C395").Value = num
-B395 = Range("B395").Value
-C395 = Range("C395").Value
-If B395 = C395 Then
-Range("D395").Value = "OK"
-Else
-Range("D395").Value = "NG"
-End If
-End Function
-
-Function test_xlWMF(ByRef num)
-Range("A396").Clear
-Range("B396").Clear
-Range("C396").Clear
-Range("D396").Clear
-Range("A396").Value = "xlWMF"
-Range("B396").Value = 2
-Range("C396").Value = num
-B396 = Range("B396").Value
-C396 = Range("C396").Value
-If B396 = C396 Then
-Range("D396").Value = "OK"
-Else
-Range("D396").Value = "NG"
-End If
-End Function
-
-Function test_xlWPG(ByRef num)
-Range("A397").Clear
-Range("B397").Clear
-Range("C397").Clear
-Range("D397").Clear
-Range("A397").Value = "xlWPG"
-Range("B397").Value = 3
-Range("C397").Value = num
-B397 = Range("B397").Value
-C397 = Range("C397").Value
-If B397 = C397 Then
-Range("D397").Value = "OK"
-Else
-Range("D397").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellBlankCell(ByRef num)
-Range("A398").Clear
-Range("B398").Clear
-Range("C398").Clear
-Range("D398").Clear
-Range("A398").Value = "xlPivotCellBlankCell"
-Range("B398").Value = 0
-Range("C398").Value = num
-B398 = Range("B398").Value
-C398 = Range("C398").Value
-If B398 = C398 Then
-Range("D398").Value = "OK"
-Else
-Range("D398").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellCustomSubtotal(ByRef num)
-Range("A399").Clear
-Range("B399").Clear
-Range("C399").Clear
-Range("D399").Clear
-Range("A399").Value = "xlPivotCellCustomSubtotal"
-Range("B399").Value = 7
-Range("C399").Value = num
-B399 = Range("B399").Value
-C399 = Range("C399").Value
-If B399 = C399 Then
-Range("D399").Value = "OK"
-Else
-Range("D399").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellDataField(ByRef num)
-Range("A400").Clear
-Range("B400").Clear
-Range("C400").Clear
-Range("D400").Clear
-Range("A400").Value = "xlPivotCellDataField"
-Range("B400").Value = 4
-Range("C400").Value = num
-B400 = Range("B400").Value
-C400 = Range("C400").Value
-If B400 = C400 Then
-Range("D400").Value = "OK"
-Else
-Range("D400").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellDataPivotField(ByRef num)
-Range("A401").Clear
-Range("B401").Clear
-Range("C401").Clear
-Range("D401").Clear
-Range("A401").Value = "xlPivotCellDataPivotField"
-Range("B401").Value = 8
-Range("C401").Value = num
-B401 = Range("B401").Value
-C401 = Range("C401").Value
-If B401 = C401 Then
-Range("D401").Value = "OK"
-Else
-Range("D401").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellGrandTotal(ByRef num)
-Range("A402").Clear
-Range("B402").Clear
-Range("C402").Clear
-Range("D402").Clear
-Range("A402").Value = "xlPivotCellGrandTotal"
-Range("B402").Value = 3
-Range("C402").Value = num
-B402 = Range("B402").Value
-C402 = Range("C402").Value
-If B402 = C402 Then
-Range("D402").Value = "OK"
-Else
-Range("D402").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellPageFieldItem(ByRef num)
-Range("A403").Clear
-Range("B403").Clear
-Range("C403").Clear
-Range("D403").Clear
-Range("A403").Value = "xlPivotCellPageFieldItem"
-Range("B403").Value = 6
-Range("C403").Value = num
-B403 = Range("B403").Value
-C403 = Range("C403").Value
-If B403 = C403 Then
-Range("D403").Value = "OK"
-Else
-Range("D403").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellPivotField(ByRef num)
-Range("A404").Clear
-Range("B404").Clear
-Range("C404").Clear
-Range("D404").Clear
-Range("A404").Value = "xlPivotCellPivotField"
-Range("B404").Value = 5
-Range("C404").Value = num
-B404 = Range("B404").Value
-C404 = Range("C404").Value
-If B404 = C404 Then
-Range("D404").Value = "OK"
-Else
-Range("D404").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellPivotItem(ByRef num)
-Range("A405").Clear
-Range("B405").Clear
-Range("C405").Clear
-Range("D405").Clear
-Range("A405").Value = "xlPivotCellPivotItem"
-Range("B405").Value = 1
-Range("C405").Value = num
-B405 = Range("B405").Value
-C405 = Range("C405").Value
-If B405 = C405 Then
-Range("D405").Value = "OK"
-Else
-Range("D405").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellSubtotal(ByRef num)
-Range("A406").Clear
-Range("B406").Clear
-Range("C406").Clear
-Range("D406").Clear
-Range("A406").Value = "xlPivotCellSubtotal"
-Range("B406").Value = 2
-Range("C406").Value = num
-B406 = Range("B406").Value
-C406 = Range("C406").Value
-If B406 = C406 Then
-Range("D406").Value = "OK"
-Else
-Range("D406").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotCellValue(ByRef num)
-Range("A407").Clear
-Range("B407").Clear
-Range("C407").Clear
-Range("D407").Clear
-Range("A407").Value = "xlPivotCellValue"
-Range("B407").Value = 0
-Range("C407").Value = num
-B407 = Range("B407").Value
-C407 = Range("C407").Value
-If B407 = C407 Then
-Range("D407").Value = "OK"
-Else
-Range("D407").Value = "NG"
-End If
-End Function
-
-Function test_xlDifferenceFrom(ByRef num)
-Range("A408").Clear
-Range("B408").Clear
-Range("C408").Clear
-Range("D408").Clear
-Range("A408").Value = "xlDifferenceFrom"
-Range("B408").Value = 2
-Range("C408").Value = num
-B408 = Range("B408").Value
-C408 = Range("C408").Value
-If B408 = C408 Then
-Range("D408").Value = "OK"
-Else
-Range("D408").Value = "NG"
-End If
-End Function
-
-Function test_xlIndex(ByRef num)
-Range("A409").Clear
-Range("B409").Clear
-Range("C409").Clear
-Range("D409").Clear
-Range("A409").Value = "xlIndex"
-Range("B409").Value = 9
-Range("C409").Value = num
-B409 = Range("B409").Value
-C409 = Range("C409").Value
-If B409 = C409 Then
-Range("D409").Value = "OK"
-Else
-Range("D409").Value = "NG"
-End If
-End Function
-
-Function test_xlNoAdditionalCalculation(ByRef num)
-Range("A410").Clear
-Range("B410").Clear
-Range("C410").Clear
-Range("D410").Clear
-Range("A410").Value = "xlNoAdditionalCalculation"
-Range("B410").Value = -4143
-Range("C410").Value = num
-B410 = Range("B410").Value
-C410 = Range("C410").Value
-If B410 = C410 Then
-Range("D410").Value = "OK"
-Else
-Range("D410").Value = "NG"
-End If
-End Function
-
-Function test_xlPercentDifferenceFrom(ByRef num)
-Range("A411").Clear
-Range("B411").Clear
-Range("C411").Clear
-Range("D411").Clear
-Range("A411").Value = "xlPercentDifferenceFrom"
-Range("B411").Value = 4
-Range("C411").Value = num
-B411 = Range("B411").Value
-C411 = Range("C411").Value
-If B411 = C411 Then
-Range("D411").Value = "OK"
-Else
-Range("D411").Value = "NG"
-End If
-End Function
-
-Function test_xlPercentOf(ByRef num)
-Range("A412").Clear
-Range("B412").Clear
-Range("C412").Clear
-Range("D412").Clear
-Range("A412").Value = "xlPercentOf"
-Range("B412").Value = 3
-Range("C412").Value = num
-B412 = Range("B412").Value
-C412 = Range("C412").Value
-If B412 = C412 Then
-Range("D412").Value = "OK"
-Else
-Range("D412").Value = "NG"
-End If
-End Function
-
-Function test_xlPercentOfColumn(ByRef num)
-Range("A413").Clear
-Range("B413").Clear
-Range("C413").Clear
-Range("D413").Clear
-Range("A413").Value = "xlPercentOfColumn"
-Range("B413").Value = 7
-Range("C413").Value = num
-B413 = Range("B413").Value
-C413 = Range("C413").Value
-If B413 = C413 Then
-Range("D413").Value = "OK"
-Else
-Range("D413").Value = "NG"
-End If
-End Function
-
-Function test_xlPercentOfRow(ByRef num)
-Range("A414").Clear
-Range("B414").Clear
-Range("C414").Clear
-Range("D414").Clear
-Range("A414").Value = "xlPercentOfRow"
-Range("B414").Value = 6
-Range("C414").Value = num
-B414 = Range("B414").Value
-C414 = Range("C414").Value
-If B414 = C414 Then
-Range("D414").Value = "OK"
-Else
-Range("D414").Value = "NG"
-End If
-End Function
-
-Function test_xlPercentOfTotal(ByRef num)
-Range("A415").Clear
-Range("B415").Clear
-Range("C415").Clear
-Range("D415").Clear
-Range("A415").Value = "xlPercentOfTotal"
-Range("B415").Value = 8
-Range("C415").Value = num
-B415 = Range("B415").Value
-C415 = Range("C415").Value
-If B415 = C415 Then
-Range("D415").Value = "OK"
-Else
-Range("D415").Value = "NG"
-End If
-End Function
-
-Function test_xlRunningTotal(ByRef num)
-Range("A416").Clear
-Range("B416").Clear
-Range("C416").Clear
-Range("D416").Clear
-Range("A416").Value = "xlRunningTotal"
-Range("B416").Value = 5
-Range("C416").Value = num
-B416 = Range("B416").Value
-C416 = Range("C416").Value
-If B416 = C416 Then
-Range("D416").Value = "OK"
-Else
-Range("D416").Value = "NG"
-End If
-End Function
-
-Function test_xlDate(ByRef num)
-Range("A417").Clear
-Range("B417").Clear
-Range("C417").Clear
-Range("D417").Clear
-Range("A417").Value = "xlDate"
-Range("B417").Value = 2
-Range("C417").Value = num
-B417 = Range("B417").Value
-C417 = Range("C417").Value
-If B417 = C417 Then
-Range("D417").Value = "OK"
-Else
-Range("D417").Value = "NG"
-End If
-End Function
-
-Function test_xlNumber(ByRef num)
-Range("A418").Clear
-Range("B418").Clear
-Range("C418").Clear
-Range("D418").Clear
-Range("A418").Value = "xlNumber"
-Range("B418").Value = -4145
-Range("C418").Value = num
-B418 = Range("B418").Value
-C418 = Range("C418").Value
-If B418 = C418 Then
-Range("D418").Value = "OK"
-Else
-Range("D418").Value = "NG"
-End If
-End Function
-
-Function test_xlText(ByRef num)
-Range("A419").Clear
-Range("B419").Clear
-Range("C419").Clear
-Range("D419").Clear
-Range("A419").Value = "xlText"
-Range("B419").Value = -4158
-Range("C419").Value = num
-B419 = Range("B419").Value
-C419 = Range("C419").Value
-If B419 = C419 Then
-Range("D419").Value = "OK"
-Else
-Range("D419").Value = "NG"
-End If
-End Function
-
-Function test_xlColumnField(ByRef num)
-Range("A420").Clear
-Range("B420").Clear
-Range("C420").Clear
-Range("D420").Clear
-Range("A420").Value = "xlColumnField"
-Range("B420").Value = 2
-Range("C420").Value = num
-B420 = Range("B420").Value
-C420 = Range("C420").Value
-If B420 = C420 Then
-Range("D420").Value = "OK"
-Else
-Range("D420").Value = "NG"
-End If
-End Function
-
-Function test_xlDataField(ByRef num)
-Range("A421").Clear
-Range("B421").Clear
-Range("C421").Clear
-Range("D421").Clear
-Range("A421").Value = "xlDataField"
-Range("B421").Value = 4
-Range("C421").Value = num
-B421 = Range("B421").Value
-C421 = Range("C421").Value
-If B421 = C421 Then
-Range("D421").Value = "OK"
-Else
-Range("D421").Value = "NG"
-End If
-End Function
-
-Function test_xlHidden(ByRef num)
-Range("A422").Clear
-Range("B422").Clear
-Range("C422").Clear
-Range("D422").Clear
-Range("A422").Value = "xlHidden"
-Range("B422").Value = 0
-Range("C422").Value = num
-B422 = Range("B422").Value
-C422 = Range("C422").Value
-If B422 = C422 Then
-Range("D422").Value = "OK"
-Else
-Range("D422").Value = "NG"
-End If
-End Function
-
-Function test_xlPageField(ByRef num)
-Range("A423").Clear
-Range("B423").Clear
-Range("C423").Clear
-Range("D423").Clear
-Range("A423").Value = "xlPageField"
-Range("B423").Value = 3
-Range("C423").Value = num
-B423 = Range("B423").Value
-C423 = Range("C423").Value
-If B423 = C423 Then
-Range("D423").Value = "OK"
-Else
-Range("D423").Value = "NG"
-End If
-End Function
-
-Function test_xlRowField(ByRef num)
-Range("A424").Clear
-Range("B424").Clear
-Range("C424").Clear
-Range("D424").Clear
-Range("A424").Value = "xlRowField"
-Range("B424").Value = 1
-Range("C424").Value = num
-B424 = Range("B424").Value
-C424 = Range("C424").Value
-If B424 = C424 Then
-Range("D424").Value = "OK"
-Else
-Range("D424").Value = "NG"
-End If
-End Function
-
-Function test_xlPTClassic(ByRef num)
-Range("A425").Clear
-Range("B425").Clear
-Range("C425").Clear
-Range("D425").Clear
-Range("A425").Value = "xlPTClassic"
-Range("B425").Value = 20
-Range("C425").Value = num
-B425 = Range("B425").Value
-C425 = Range("C425").Value
-If B425 = C425 Then
-Range("D425").Value = "OK"
-Else
-Range("D425").Value = "NG"
-End If
-End Function
-
-Function test_xlPTNone(ByRef num)
-Range("A426").Clear
-Range("B426").Clear
-Range("C426").Clear
-Range("D426").Clear
-Range("A426").Value = "xlPTNone"
-Range("B426").Value = 21
-Range("C426").Value = num
-B426 = Range("B426").Value
-C426 = Range("C426").Value
-If B426 = C426 Then
-Range("D426").Value = "OK"
-Else
-Range("D426").Value = "NG"
-End If
-End Function
-
-Function test_xlReport1(ByRef num)
-Range("A427").Clear
-Range("B427").Clear
-Range("C427").Clear
-Range("D427").Clear
-Range("A427").Value = "xlReport1"
-Range("B427").Value = 0
-Range("C427").Value = num
-B427 = Range("B427").Value
-C427 = Range("C427").Value
-If B427 = C427 Then
-Range("D427").Value = "OK"
-Else
-Range("D427").Value = "NG"
-End If
-End Function
-
-Function test_xlReport10(ByRef num)
-Range("A428").Clear
-Range("B428").Clear
-Range("C428").Clear
-Range("D428").Clear
-Range("A428").Value = "xlReport10"
-Range("B428").Value = 9
-Range("C428").Value = num
-B428 = Range("B428").Value
-C428 = Range("C428").Value
-If B428 = C428 Then
-Range("D428").Value = "OK"
-Else
-Range("D428").Value = "NG"
-End If
-End Function
-
-Function test_xlReport2(ByRef num)
-Range("A429").Clear
-Range("B429").Clear
-Range("C429").Clear
-Range("D429").Clear
-Range("A429").Value = "xlReport2"
-Range("B429").Value = 1
-Range("C429").Value = num
-B429 = Range("B429").Value
-C429 = Range("C429").Value
-If B429 = C429 Then
-Range("D429").Value = "OK"
-Else
-Range("D429").Value = "NG"
-End If
-End Function
-
-Function test_xlReport3(ByRef num)
-Range("A430").Clear
-Range("B430").Clear
-Range("C430").Clear
-Range("D430").Clear
-Range("A430").Value = "xlReport3"
-Range("B430").Value = 2
-Range("C430").Value = num
-B430 = Range("B430").Value
-C430 = Range("C430").Value
-If B430 = C430 Then
-Range("D430").Value = "OK"
-Else
-Range("D430").Value = "NG"
-End If
-End Function
-
-Function test_xlReport4(ByRef num)
-Range("A431").Clear
-Range("B431").Clear
-Range("C431").Clear
-Range("D431").Clear
-Range("A431").Value = "xlReport4"
-Range("B431").Value = 3
-Range("C431").Value = num
-B431 = Range("B431").Value
-C431 = Range("C431").Value
-If B431 = C431 Then
-Range("D431").Value = "OK"
-Else
-Range("D431").Value = "NG"
-End If
-End Function
-
-Function test_xlReport5(ByRef num)
-Range("A432").Clear
-Range("B432").Clear
-Range("C432").Clear
-Range("D432").Clear
-Range("A432").Value = "xlReport5"
-Range("B432").Value = 4
-Range("C432").Value = num
-B432 = Range("B432").Value
-C432 = Range("C432").Value
-If B432 = C432 Then
-Range("D432").Value = "OK"
-Else
-Range("D432").Value = "NG"
-End If
-End Function
-
-Function test_xlReport6(ByRef num)
-Range("A433").Clear
-Range("B433").Clear
-Range("C433").Clear
-Range("D433").Clear
-Range("A433").Value = "xlReport6"
-Range("B433").Value = 5
-Range("C433").Value = num
-B433 = Range("B433").Value
-C433 = Range("C433").Value
-If B433 = C433 Then
-Range("D433").Value = "OK"
-Else
-Range("D433").Value = "NG"
-End If
-End Function
-
-Function test_xlReport7(ByRef num)
-Range("A434").Clear
-Range("B434").Clear
-Range("C434").Clear
-Range("D434").Clear
-Range("A434").Value = "xlReport7"
-Range("B434").Value = 6
-Range("C434").Value = num
-B434 = Range("B434").Value
-C434 = Range("C434").Value
-If B434 = C434 Then
-Range("D434").Value = "OK"
-Else
-Range("D434").Value = "NG"
-End If
-End Function
-
-Function test_xlReport8(ByRef num)
-Range("A435").Clear
-Range("B435").Clear
-Range("C435").Clear
-Range("D435").Clear
-Range("A435").Value = "xlReport8"
-Range("B435").Value = 7
-Range("C435").Value = num
-B435 = Range("B435").Value
-C435 = Range("C435").Value
-If B435 = C435 Then
-Range("D435").Value = "OK"
-Else
-Range("D435").Value = "NG"
-End If
-End Function
-
-Function test_xlReport9(ByRef num)
-Range("A436").Clear
-Range("B436").Clear
-Range("C436").Clear
-Range("D436").Clear
-Range("A436").Value = "xlReport9"
-Range("B436").Value = 8
-Range("C436").Value = num
-B436 = Range("B436").Value
-C436 = Range("C436").Value
-If B436 = C436 Then
-Range("D436").Value = "OK"
-Else
-Range("D436").Value = "NG"
-End If
-End Function
-
-Function test_xlTable1(ByRef num)
-Range("A437").Clear
-Range("B437").Clear
-Range("C437").Clear
-Range("D437").Clear
-Range("A437").Value = "xlTable1"
-Range("B437").Value = 10
-Range("C437").Value = num
-B437 = Range("B437").Value
-C437 = Range("C437").Value
-If B437 = C437 Then
-Range("D437").Value = "OK"
-Else
-Range("D437").Value = "NG"
-End If
-End Function
-
-Function test_xlTable10(ByRef num)
-Range("A438").Clear
-Range("B438").Clear
-Range("C438").Clear
-Range("D438").Clear
-Range("A438").Value = "xlTable10"
-Range("B438").Value = 19
-Range("C438").Value = num
-B438 = Range("B438").Value
-C438 = Range("C438").Value
-If B438 = C438 Then
-Range("D438").Value = "OK"
-Else
-Range("D438").Value = "NG"
-End If
-End Function
-
-Function test_xlTable2(ByRef num)
-Range("A439").Clear
-Range("B439").Clear
-Range("C439").Clear
-Range("D439").Clear
-Range("A439").Value = "xlTable2"
-Range("B439").Value = 11
-Range("C439").Value = num
-B439 = Range("B439").Value
-C439 = Range("C439").Value
-If B439 = C439 Then
-Range("D439").Value = "OK"
-Else
-Range("D439").Value = "NG"
-End If
-End Function
-
-Function test_xlTable3(ByRef num)
-Range("A440").Clear
-Range("B440").Clear
-Range("C440").Clear
-Range("D440").Clear
-Range("A440").Value = "xlTable3"
-Range("B440").Value = 12
-Range("C440").Value = num
-B440 = Range("B440").Value
-C440 = Range("C440").Value
-If B440 = C440 Then
-Range("D440").Value = "OK"
-Else
-Range("D440").Value = "NG"
-End If
-End Function
-
-Function test_xlTable4(ByRef num)
-Range("A441").Clear
-Range("B441").Clear
-Range("C441").Clear
-Range("D441").Clear
-Range("A441").Value = "xlTable4"
-Range("B441").Value = 13
-Range("C441").Value = num
-B441 = Range("B441").Value
-C441 = Range("C441").Value
-If B441 = C441 Then
-Range("D441").Value = "OK"
-Else
-Range("D441").Value = "NG"
-End If
-End Function
-
-Function test_xlTable5(ByRef num)
-Range("A442").Clear
-Range("B442").Clear
-Range("C442").Clear
-Range("D442").Clear
-Range("A442").Value = "xlTable5"
-Range("B442").Value = 14
-Range("C442").Value = num
-B442 = Range("B442").Value
-C442 = Range("C442").Value
-If B442 = C442 Then
-Range("D442").Value = "OK"
-Else
-Range("D442").Value = "NG"
-End If
-End Function
-
-Function test_xlTable6(ByRef num)
-Range("A443").Clear
-Range("B443").Clear
-Range("C443").Clear
-Range("D443").Clear
-Range("A443").Value = "xlTable6"
-Range("B443").Value = 15
-Range("C443").Value = num
-B443 = Range("B443").Value
-C443 = Range("C443").Value
-If B443 = C443 Then
-Range("D443").Value = "OK"
-Else
-Range("D443").Value = "NG"
-End If
-End Function
-
-Function test_xlTable7(ByRef num)
-Range("A444").Clear
-Range("B444").Clear
-Range("C444").Clear
-Range("D444").Clear
-Range("A444").Value = "xlTable7"
-Range("B444").Value = 16
-Range("C444").Value = num
-B444 = Range("B444").Value
-C444 = Range("C444").Value
-If B444 = C444 Then
-Range("D444").Value = "OK"
-Else
-Range("D444").Value = "NG"
-End If
-End Function
-
-Function test_xlTable8(ByRef num)
-Range("A445").Clear
-Range("B445").Clear
-Range("C445").Clear
-Range("D445").Clear
-Range("A445").Value = "xlTable8"
-Range("B445").Value = 17
-Range("C445").Value = num
-B445 = Range("B445").Value
-C445 = Range("C445").Value
-If B445 = C445 Then
-Range("D445").Value = "OK"
-Else
-Range("D445").Value = "NG"
-End If
-End Function
-
-Function test_xlTable9(ByRef num)
-Range("A446").Clear
-Range("B446").Clear
-Range("C446").Clear
-Range("D446").Clear
-Range("A446").Value = "xlTable9"
-Range("B446").Value = 18
-Range("C446").Value = num
-B446 = Range("B446").Value
-C446 = Range("C446").Value
-If B446 = C446 Then
-Range("D446").Value = "OK"
-Else
-Range("D446").Value = "NG"
-End If
-End Function
-
-Function test_xlMissingItemsDefault(ByRef num)
-Range("A447").Clear
-Range("B447").Clear
-Range("C447").Clear
-Range("D447").Clear
-Range("A447").Value = "xlMissingItemsDefault"
-Range("B447").Value = -1
-Range("C447").Value = num
-B447 = Range("B447").Value
-C447 = Range("C447").Value
-If B447 = C447 Then
-Range("D447").Value = "OK"
-Else
-Range("D447").Value = "NG"
-End If
-End Function
-
-Function test_xlMissingItemsMax(ByRef num)
-Range("A448").Clear
-Range("B448").Clear
-Range("C448").Clear
-Range("D448").Clear
-Range("A448").Value = "xlMissingItemsMax"
-Range("B448").Value = 32500
-Range("C448").Value = num
-B448 = Range("B448").Value
-C448 = Range("C448").Value
-If B448 = C448 Then
-Range("D448").Value = "OK"
-Else
-Range("D448").Value = "NG"
-End If
-End Function
-
-Function test_xlMissingItemsNone(ByRef num)
-Range("A449").Clear
-Range("B449").Clear
-Range("C449").Clear
-Range("D449").Clear
-Range("A449").Value = "xlMissingItemsNone"
-Range("B449").Value = 0
-Range("C449").Value = num
-B449 = Range("B449").Value
-C449 = Range("C449").Value
-If B449 = C449 Then
-Range("D449").Value = "OK"
-Else
-Range("D449").Value = "NG"
-End If
-End Function
-
-Function test_xlConsolidation(ByRef num)
-Range("A450").Clear
-Range("B450").Clear
-Range("C450").Clear
-Range("D450").Clear
-Range("A450").Value = "xlConsolidation"
-Range("B450").Value = 3
-Range("C450").Value = num
-B450 = Range("B450").Value
-C450 = Range("C450").Value
-If B450 = C450 Then
-Range("D450").Value = "OK"
-Else
-Range("D450").Value = "NG"
-End If
-End Function
-
-Function test_xlDatabase(ByRef num)
-Range("A451").Clear
-Range("B451").Clear
-Range("C451").Clear
-Range("D451").Clear
-Range("A451").Value = "xlDatabase"
-Range("B451").Value = 1
-Range("C451").Value = num
-B451 = Range("B451").Value
-C451 = Range("C451").Value
-If B451 = C451 Then
-Range("D451").Value = "OK"
-Else
-Range("D451").Value = "NG"
-End If
-End Function
-
-Function test_xlExternal(ByRef num)
-Range("A452").Clear
-Range("B452").Clear
-Range("C452").Clear
-Range("D452").Clear
-Range("A452").Value = "xlExternal"
-Range("B452").Value = 2
-Range("C452").Value = num
-B452 = Range("B452").Value
-C452 = Range("C452").Value
-If B452 = C452 Then
-Range("D452").Value = "OK"
-Else
-Range("D452").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotTable(ByRef num)
-Range("A453").Clear
-Range("B453").Clear
-Range("C453").Clear
-Range("D453").Clear
-Range("A453").Value = "xlPivotTable"
-Range("B453").Value = -4148
-Range("C453").Value = num
-B453 = Range("B453").Value
-C453 = Range("C453").Value
-If B453 = C453 Then
-Range("D453").Value = "OK"
-Else
-Range("D453").Value = "NG"
-End If
-End Function
-
-Function test_xlScenario(ByRef num)
-Range("A454").Clear
-Range("B454").Clear
-Range("C454").Clear
-Range("D454").Clear
-Range("A454").Value = "xlScenario"
-Range("B454").Value = 4
-Range("C454").Value = num
-B454 = Range("B454").Value
-C454 = Range("C454").Value
-If B454 = C454 Then
-Range("D454").Value = "OK"
-Else
-Range("D454").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotTableVersion10(ByRef num)
-Range("A455").Clear
-Range("B455").Clear
-Range("C455").Clear
-Range("D455").Clear
-Range("A455").Value = "xlPivotTableVersion10"
-Range("B455").Value = 1
-Range("C455").Value = num
-B455 = Range("B455").Value
-C455 = Range("C455").Value
-If B455 = C455 Then
-Range("D455").Value = "OK"
-Else
-Range("D455").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotTableVersion2000(ByRef num)
-Range("A456").Clear
-Range("B456").Clear
-Range("C456").Clear
-Range("D456").Clear
-Range("A456").Value = "xlPivotTableVersion2000"
-Range("B456").Value = 0
-Range("C456").Value = num
-B456 = Range("B456").Value
-C456 = Range("C456").Value
-If B456 = C456 Then
-Range("D456").Value = "OK"
-Else
-Range("D456").Value = "NG"
-End If
-End Function
-
-Function test_xlPivotTableCurrent(ByRef num)
-Range("A457").Clear
-Range("B457").Clear
-Range("C457").Clear
-Range("D457").Clear
-Range("A457").Value = "xlPivotTableCurrent"
-Range("B457").Value = -1
-Range("C457").Value = num
-B457 = Range("B457").Value
-C457 = Range("C457").Value
-If B457 = C457 Then
-Range("D457").Value = "OK"
-Else
-Range("D457").Value = "NG"
-End If
-End Function
-
-Function test_xlFreeFloating(ByRef num)
-Range("A458").Clear
-Range("B458").Clear
-Range("C458").Clear
-Range("D458").Clear
-Range("A458").Value = "xlFreeFloating"
-Range("B458").Value = 3
-Range("C458").Value = num
-B458 = Range("B458").Value
-C458 = Range("C458").Value
-If B458 = C458 Then
-Range("D458").Value = "OK"
-Else
-Range("D458").Value = "NG"
-End If
-End Function
-
-Function test_xlMove(ByRef num)
-Range("A459").Clear
-Range("B459").Clear
-Range("C459").Clear
-Range("D459").Clear
-Range("A459").Value = "xlMove"
-Range("B459").Value = 2
-Range("C459").Value = num
-B459 = Range("B459").Value
-C459 = Range("C459").Value
-If B459 = C459 Then
-Range("D459").Value = "OK"
-Else
-Range("D459").Value = "NG"
-End If
-End Function
-
-Function test_xlMoveAndSize(ByRef num)
-Range("A460").Clear
-Range("B460").Clear
-Range("C460").Clear
-Range("D460").Clear
-Range("A460").Value = "xlMoveAndSize"
-Range("B460").Value = 1
-Range("C460").Value = num
-B460 = Range("B460").Value
-C460 = Range("C460").Value
-If B460 = C460 Then
-Range("D460").Value = "OK"
-Else
-Range("D460").Value = "NG"
-End If
-End Function
-
-Function test_xlMacintosh(ByRef num)
-Range("A461").Clear
-Range("B461").Clear
-Range("C461").Clear
-Range("D461").Clear
-Range("A461").Value = "xlMacintosh"
-Range("B461").Value = 1
-Range("C461").Value = num
-B461 = Range("B461").Value
-C461 = Range("C461").Value
-If B461 = C461 Then
-Range("D461").Value = "OK"
-Else
-Range("D461").Value = "NG"
-End If
-End Function
-
-Function test_xlMSDOS(ByRef num)
-Range("A462").Clear
-Range("B462").Clear
-Range("C462").Clear
-Range("D462").Clear
-Range("A462").Value = "xlMSDOS"
-Range("B462").Value = 3
-Range("C462").Value = num
-B462 = Range("B462").Value
-C462 = Range("C462").Value
-If B462 = C462 Then
-Range("D462").Value = "OK"
-Else
-Range("D462").Value = "NG"
-End If
-End Function
-
-Function test_xlWindows(ByRef num)
-Range("A463").Clear
-Range("B463").Clear
-Range("C463").Clear
-Range("D463").Clear
-Range("A463").Value = "xlWindows"
-Range("B463").Value = 2
-Range("C463").Value = num
-B463 = Range("B463").Value
-C463 = Range("C463").Value
-If B463 = C463 Then
-Range("D463").Value = "OK"
-Else
-Range("D463").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintErrorsBlank(ByRef num)
-Range("A464").Clear
-Range("B464").Clear
-Range("C464").Clear
-Range("D464").Clear
-Range("A464").Value = "xlPrintErrorsBlank"
-Range("B464").Value = 1
-Range("C464").Value = num
-B464 = Range("B464").Value
-C464 = Range("C464").Value
-If B464 = C464 Then
-Range("D464").Value = "OK"
-Else
-Range("D464").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintErrorsDash(ByRef num)
-Range("A465").Clear
-Range("B465").Clear
-Range("C465").Clear
-Range("D465").Clear
-Range("A465").Value = "xlPrintErrorsDash"
-Range("B465").Value = 2
-Range("C465").Value = num
-B465 = Range("B465").Value
-C465 = Range("C465").Value
-If B465 = C465 Then
-Range("D465").Value = "OK"
-Else
-Range("D465").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintErrorsDisplayed(ByRef num)
-Range("A466").Clear
-Range("B466").Clear
-Range("C466").Clear
-Range("D466").Clear
-Range("A466").Value = "xlPrintErrorsDisplayed"
-Range("B466").Value = 0
-Range("C466").Value = num
-B466 = Range("B466").Value
-C466 = Range("C466").Value
-If B466 = C466 Then
-Range("D466").Value = "OK"
-Else
-Range("D466").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintErrorsNA(ByRef num)
-Range("A467").Clear
-Range("B467").Clear
-Range("C467").Clear
-Range("D467").Clear
-Range("A467").Value = "xlPrintErrorsNA"
-Range("B467").Value = 3
-Range("C467").Value = num
-B467 = Range("B467").Value
-C467 = Range("C467").Value
-If B467 = C467 Then
-Range("D467").Value = "OK"
-Else
-Range("D467").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintLocation(ByRef num)
-Range("A468").Clear
-Range("B468").Clear
-Range("C468").Clear
-Range("D468").Clear
-Range("A468").Value = "xlPrintLocation"
-Range("B468").Value = 16
-Range("C468").Value = num
-B468 = Range("B468").Value
-C468 = Range("C468").Value
-If B468 = C468 Then
-Range("D468").Value = "OK"
-Else
-Range("D468").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintNoComments(ByRef num)
-Range("A469").Clear
-Range("B469").Clear
-Range("C469").Clear
-Range("D469").Clear
-Range("A469").Value = "xlPrintNoComments"
-Range("B469").Value = -4142
-Range("C469").Value = num
-B469 = Range("B469").Value
-C469 = Range("C469").Value
-If B469 = C469 Then
-Range("D469").Value = "OK"
-Else
-Range("D469").Value = "NG"
-End If
-End Function
-
-Function test_xlPrintSheetEnd(ByRef num)
-Range("A470").Clear
-Range("B470").Clear
-Range("C470").Clear
-Range("D470").Clear
-Range("A470").Value = "xlPrintSheetEnd"
-Range("B470").Value = 1
-Range("C470").Value = num
-B470 = Range("B470").Value
-C470 = Range("C470").Value
-If B470 = C470 Then
-Range("D470").Value = "OK"
-Else
-Range("D470").Value = "NG"
-End If
-End Function
-
-Function test_xlPriorityHigh(ByRef num)
-Range("A471").Clear
-Range("B471").Clear
-Range("C471").Clear
-Range("D471").Clear
-Range("A471").Value = "xlPriorityHigh"
-Range("B471").Value = -4127
-Range("C471").Value = num
-B471 = Range("B471").Value
-C471 = Range("C471").Value
-If B471 = C471 Then
-Range("D471").Value = "OK"
-Else
-Range("D471").Value = "NG"
-End If
-End Function
-
-Function test_xlPriorityLow(ByRef num)
-Range("A472").Clear
-Range("B472").Clear
-Range("C472").Clear
-Range("D472").Clear
-Range("A472").Value = "xlPriorityLow"
-Range("B472").Value = -4134
-Range("C472").Value = num
-B472 = Range("B472").Value
-C472 = Range("C472").Value
-If B472 = C472 Then
-Range("D472").Value = "OK"
-Else
-Range("D472").Value = "NG"
-End If
-End Function
-
-Function test_xlPriorityNormal(ByRef num)
-Range("A473").Clear
-Range("B473").Clear
-Range("C473").Clear
-Range("D473").Clear
-Range("A473").Value = "xlPriorityNormal"
-Range("B473").Value = -4143
-Range("C473").Value = num
-B473 = Range("B473").Value
-C473 = Range("C473").Value
-If B473 = C473 Then
-Range("D473").Value = "OK"
-Else
-Range("D473").Value = "NG"
-End If
-End Function
-
-Function test_xlADORecordset(ByRef num)
-Range("A474").Clear
-Range("B474").Clear
-Range("C474").Clear
-Range("D474").Clear
-Range("A474").Value = "xlADORecordset"
-Range("B474").Value = 7
-Range("C474").Value = num
-B474 = Range("B474").Value
-C474 = Range("C474").Value
-If B474 = C474 Then
-Range("D474").Value = "OK"
-Else
-Range("D474").Value = "NG"
-End If
-End Function
-
-Function test_xlDAORecordset(ByRef num)
-Range("A475").Clear
-Range("B475").Clear
-Range("C475").Clear
-Range("D475").Clear
-Range("A475").Value = "xlDAORecordset"
-Range("B475").Value = 2
-Range("C475").Value = num
-B475 = Range("B475").Value
-C475 = Range("C475").Value
-If B475 = C475 Then
-Range("D475").Value = "OK"
-Else
-Range("D475").Value = "NG"
-End If
-End Function
-
-Function test_xlODBCQuery(ByRef num)
-Range("A476").Clear
-Range("B476").Clear
-Range("C476").Clear
-Range("D476").Clear
-Range("A476").Value = "xlODBCQuery"
-Range("B476").Value = 1
-Range("C476").Value = num
-B476 = Range("B476").Value
-C476 = Range("C476").Value
-If B476 = C476 Then
-Range("D476").Value = "OK"
-Else
-Range("D476").Value = "NG"
-End If
-End Function
-
-Function test_xlOLEDBQuery(ByRef num)
-Range("A477").Clear
-Range("B477").Clear
-Range("C477").Clear
-Range("D477").Clear
-Range("A477").Value = "xlOLEDBQuery"
-Range("B477").Value = 5
-Range("C477").Value = num
-B477 = Range("B477").Value
-C477 = Range("C477").Value
-If B477 = C477 Then
-Range("D477").Value = "OK"
-Else
-Range("D477").Value = "NG"
-End If
-End Function
-
-Function test_xlTextImport(ByRef num)
-Range("A478").Clear
-Range("B478").Clear
-Range("C478").Clear
-Range("D478").Clear
-Range("A478").Value = "xlTextImport"
-Range("B478").Value = 6
-Range("C478").Value = num
-B478 = Range("B478").Value
-C478 = Range("C478").Value
-If B478 = C478 Then
-Range("D478").Value = "OK"
-Else
-Range("D478").Value = "NG"
-End If
-End Function
-
-Function test_xlWebQuery(ByRef num)
-Range("A479").Clear
-Range("B479").Clear
-Range("C479").Clear
-Range("D479").Clear
-Range("A479").Value = "xlWebQuery"
-Range("B479").Value = 4
-Range("C479").Value = num
-B479 = Range("B479").Value
-C479 = Range("C479").Value
-If B479 = C479 Then
-Range("D479").Value = "OK"
-Else
-Range("D479").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormat3DEffects1(ByRef num)
-Range("A480").Clear
-Range("B480").Clear
-Range("C480").Clear
-Range("D480").Clear
-Range("A480").Value = "xlRangeAutoFormat3DEffects1"
-Range("B480").Value = 13
-Range("C480").Value = num
-B480 = Range("B480").Value
-C480 = Range("C480").Value
-If B480 = C480 Then
-Range("D480").Value = "OK"
-Else
-Range("D480").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormat3DEffects2(ByRef num)
-Range("A481").Clear
-Range("B481").Clear
-Range("C481").Clear
-Range("D481").Clear
-Range("A481").Value = "xlRangeAutoFormat3DEffects2"
-Range("B481").Value = 14
-Range("C481").Value = num
-B481 = Range("B481").Value
-C481 = Range("C481").Value
-If B481 = C481 Then
-Range("D481").Value = "OK"
-Else
-Range("D481").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatAccounting1(ByRef num)
-Range("A482").Clear
-Range("B482").Clear
-Range("C482").Clear
-Range("D482").Clear
-Range("A482").Value = "xlRangeAutoFormatAccounting1"
-Range("B482").Value = 4
-Range("C482").Value = num
-B482 = Range("B482").Value
-C482 = Range("C482").Value
-If B482 = C482 Then
-Range("D482").Value = "OK"
-Else
-Range("D482").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatAccounting2(ByRef num)
-Range("A483").Clear
-Range("B483").Clear
-Range("C483").Clear
-Range("D483").Clear
-Range("A483").Value = "xlRangeAutoFormatAccounting2"
-Range("B483").Value = 5
-Range("C483").Value = num
-B483 = Range("B483").Value
-C483 = Range("C483").Value
-If B483 = C483 Then
-Range("D483").Value = "OK"
-Else
-Range("D483").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatAccounting3(ByRef num)
-Range("A484").Clear
-Range("B484").Clear
-Range("C484").Clear
-Range("D484").Clear
-Range("A484").Value = "xlRangeAutoFormatAccounting3"
-Range("B484").Value = 6
-Range("C484").Value = num
-B484 = Range("B484").Value
-C484 = Range("C484").Value
-If B484 = C484 Then
-Range("D484").Value = "OK"
-Else
-Range("D484").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatAccounting4(ByRef num)
-Range("A485").Clear
-Range("B485").Clear
-Range("C485").Clear
-Range("D485").Clear
-Range("A485").Value = "xlRangeAutoFormatAccounting4"
-Range("B485").Value = 17
-Range("C485").Value = num
-B485 = Range("B485").Value
-C485 = Range("C485").Value
-If B485 = C485 Then
-Range("D485").Value = "OK"
-Else
-Range("D485").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatClassic1(ByRef num)
-Range("A486").Clear
-Range("B486").Clear
-Range("C486").Clear
-Range("D486").Clear
-Range("A486").Value = "xlRangeAutoFormatClassic1"
-Range("B486").Value = 1
-Range("C486").Value = num
-B486 = Range("B486").Value
-C486 = Range("C486").Value
-If B486 = C486 Then
-Range("D486").Value = "OK"
-Else
-Range("D486").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatClassic2(ByRef num)
-Range("A487").Clear
-Range("B487").Clear
-Range("C487").Clear
-Range("D487").Clear
-Range("A487").Value = "xlRangeAutoFormatClassic2"
-Range("B487").Value = 2
-Range("C487").Value = num
-B487 = Range("B487").Value
-C487 = Range("C487").Value
-If B487 = C487 Then
-Range("D487").Value = "OK"
-Else
-Range("D487").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatClassic3(ByRef num)
-Range("A488").Clear
-Range("B488").Clear
-Range("C488").Clear
-Range("D488").Clear
-Range("A488").Value = "xlRangeAutoFormatClassic3"
-Range("B488").Value = 3
-Range("C488").Value = num
-B488 = Range("B488").Value
-C488 = Range("C488").Value
-If B488 = C488 Then
-Range("D488").Value = "OK"
-Else
-Range("D488").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatClassicPivotTable(ByRef num)
-Range("A489").Clear
-Range("B489").Clear
-Range("C489").Clear
-Range("D489").Clear
-Range("A489").Value = "xlRangeAutoFormatClassicPivotTable"
-Range("B489").Value = 31
-Range("C489").Value = num
-B489 = Range("B489").Value
-C489 = Range("C489").Value
-If B489 = C489 Then
-Range("D489").Value = "OK"
-Else
-Range("D489").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatColor1(ByRef num)
-Range("A490").Clear
-Range("B490").Clear
-Range("C490").Clear
-Range("D490").Clear
-Range("A490").Value = "xlRangeAutoFormatColor1"
-Range("B490").Value = 7
-Range("C490").Value = num
-B490 = Range("B490").Value
-C490 = Range("C490").Value
-If B490 = C490 Then
-Range("D490").Value = "OK"
-Else
-Range("D490").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatColor2(ByRef num)
-Range("A491").Clear
-Range("B491").Clear
-Range("C491").Clear
-Range("D491").Clear
-Range("A491").Value = "xlRangeAutoFormatColor2"
-Range("B491").Value = 8
-Range("C491").Value = num
-B491 = Range("B491").Value
-C491 = Range("C491").Value
-If B491 = C491 Then
-Range("D491").Value = "OK"
-Else
-Range("D491").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatColor3(ByRef num)
-Range("A492").Clear
-Range("B492").Clear
-Range("C492").Clear
-Range("D492").Clear
-Range("A492").Value = "xlRangeAutoFormatColor3"
-Range("B492").Value = 9
-Range("C492").Value = num
-B492 = Range("B492").Value
-C492 = Range("C492").Value
-If B492 = C492 Then
-Range("D492").Value = "OK"
-Else
-Range("D492").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatList1(ByRef num)
-Range("A493").Clear
-Range("B493").Clear
-Range("C493").Clear
-Range("D493").Clear
-Range("A493").Value = "xlRangeAutoFormatList1"
-Range("B493").Value = 10
-Range("C493").Value = num
-B493 = Range("B493").Value
-C493 = Range("C493").Value
-If B493 = C493 Then
-Range("D493").Value = "OK"
-Else
-Range("D493").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatList2(ByRef num)
-Range("A494").Clear
-Range("B494").Clear
-Range("C494").Clear
-Range("D494").Clear
-Range("A494").Value = "xlRangeAutoFormatList2"
-Range("B494").Value = 11
-Range("C494").Value = num
-B494 = Range("B494").Value
-C494 = Range("C494").Value
-If B494 = C494 Then
-Range("D494").Value = "OK"
-Else
-Range("D494").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatList3(ByRef num)
-Range("A495").Clear
-Range("B495").Clear
-Range("C495").Clear
-Range("D495").Clear
-Range("A495").Value = "xlRangeAutoFormatList3"
-Range("B495").Value = 12
-Range("C495").Value = num
-B495 = Range("B495").Value
-C495 = Range("C495").Value
-If B495 = C495 Then
-Range("D495").Value = "OK"
-Else
-Range("D495").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatLocalFormat1(ByRef num)
-Range("A496").Clear
-Range("B496").Clear
-Range("C496").Clear
-Range("D496").Clear
-Range("A496").Value = "xlRangeAutoFormatLocalFormat1"
-Range("B496").Value = 15
-Range("C496").Value = num
-B496 = Range("B496").Value
-C496 = Range("C496").Value
-If B496 = C496 Then
-Range("D496").Value = "OK"
-Else
-Range("D496").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatLocalFormat2(ByRef num)
-Range("A497").Clear
-Range("B497").Clear
-Range("C497").Clear
-Range("D497").Clear
-Range("A497").Value = "xlRangeAutoFormatLocalFormat2"
-Range("B497").Value = 16
-Range("C497").Value = num
-B497 = Range("B497").Value
-C497 = Range("C497").Value
-If B497 = C497 Then
-Range("D497").Value = "OK"
-Else
-Range("D497").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatLocalFormat3(ByRef num)
-Range("A498").Clear
-Range("B498").Clear
-Range("C498").Clear
-Range("D498").Clear
-Range("A498").Value = "xlRangeAutoFormatLocalFormat3"
-Range("B498").Value = 19
-Range("C498").Value = num
-B498 = Range("B498").Value
-C498 = Range("C498").Value
-If B498 = C498 Then
-Range("D498").Value = "OK"
-Else
-Range("D498").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatLocalFormat4(ByRef num)
-Range("A499").Clear
-Range("B499").Clear
-Range("C499").Clear
-Range("D499").Clear
-Range("A499").Value = "xlRangeAutoFormatLocalFormat4"
-Range("B499").Value = 20
-Range("C499").Value = num
-B499 = Range("B499").Value
-C499 = Range("C499").Value
-If B499 = C499 Then
-Range("D499").Value = "OK"
-Else
-Range("D499").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatNone(ByRef num)
-Range("A500").Clear
-Range("B500").Clear
-Range("C500").Clear
-Range("D500").Clear
-Range("A500").Value = "xlRangeAutoFormatNone"
-Range("B500").Value = -4142
-Range("C500").Value = num
-B500 = Range("B500").Value
-C500 = Range("C500").Value
-If B500 = C500 Then
-Range("D500").Value = "OK"
-Else
-Range("D500").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatPTNone(ByRef num)
-Range("A501").Clear
-Range("B501").Clear
-Range("C501").Clear
-Range("D501").Clear
-Range("A501").Value = "xlRangeAutoFormatPTNone"
-Range("B501").Value = 42
-Range("C501").Value = num
-B501 = Range("B501").Value
-C501 = Range("C501").Value
-If B501 = C501 Then
-Range("D501").Value = "OK"
-Else
-Range("D501").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport1(ByRef num)
-Range("A502").Clear
-Range("B502").Clear
-Range("C502").Clear
-Range("D502").Clear
-Range("A502").Value = "xlRangeAutoFormatReport1"
-Range("B502").Value = 21
-Range("C502").Value = num
-B502 = Range("B502").Value
-C502 = Range("C502").Value
-If B502 = C502 Then
-Range("D502").Value = "OK"
-Else
-Range("D502").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport10(ByRef num)
-Range("A503").Clear
-Range("B503").Clear
-Range("C503").Clear
-Range("D503").Clear
-Range("A503").Value = "xlRangeAutoFormatReport10"
-Range("B503").Value = 30
-Range("C503").Value = num
-B503 = Range("B503").Value
-C503 = Range("C503").Value
-If B503 = C503 Then
-Range("D503").Value = "OK"
-Else
-Range("D503").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport2(ByRef num)
-Range("A504").Clear
-Range("B504").Clear
-Range("C504").Clear
-Range("D504").Clear
-Range("A504").Value = "xlRangeAutoFormatReport2"
-Range("B504").Value = 22
-Range("C504").Value = num
-B504 = Range("B504").Value
-C504 = Range("C504").Value
-If B504 = C504 Then
-Range("D504").Value = "OK"
-Else
-Range("D504").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport3(ByRef num)
-Range("A505").Clear
-Range("B505").Clear
-Range("C505").Clear
-Range("D505").Clear
-Range("A505").Value = "xlRangeAutoFormatReport3"
-Range("B505").Value = 23
-Range("C505").Value = num
-B505 = Range("B505").Value
-C505 = Range("C505").Value
-If B505 = C505 Then
-Range("D505").Value = "OK"
-Else
-Range("D505").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport4(ByRef num)
-Range("A506").Clear
-Range("B506").Clear
-Range("C506").Clear
-Range("D506").Clear
-Range("A506").Value = "xlRangeAutoFormatReport4"
-Range("B506").Value = 24
-Range("C506").Value = num
-B506 = Range("B506").Value
-C506 = Range("C506").Value
-If B506 = C506 Then
-Range("D506").Value = "OK"
-Else
-Range("D506").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport5(ByRef num)
-Range("A507").Clear
-Range("B507").Clear
-Range("C507").Clear
-Range("D507").Clear
-Range("A507").Value = "xlRangeAutoFormatReport5"
-Range("B507").Value = 25
-Range("C507").Value = num
-B507 = Range("B507").Value
-C507 = Range("C507").Value
-If B507 = C507 Then
-Range("D507").Value = "OK"
-Else
-Range("D507").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport6(ByRef num)
-Range("A508").Clear
-Range("B508").Clear
-Range("C508").Clear
-Range("D508").Clear
-Range("A508").Value = "xlRangeAutoFormatReport6"
-Range("B508").Value = 26
-Range("C508").Value = num
-B508 = Range("B508").Value
-C508 = Range("C508").Value
-If B508 = C508 Then
-Range("D508").Value = "OK"
-Else
-Range("D508").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport7(ByRef num)
-Range("A509").Clear
-Range("B509").Clear
-Range("C509").Clear
-Range("D509").Clear
-Range("A509").Value = "xlRangeAutoFormatReport7"
-Range("B509").Value = 27
-Range("C509").Value = num
-B509 = Range("B509").Value
-C509 = Range("C509").Value
-If B509 = C509 Then
-Range("D509").Value = "OK"
-Else
-Range("D509").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport8(ByRef num)
-Range("A510").Clear
-Range("B510").Clear
-Range("C510").Clear
-Range("D510").Clear
-Range("A510").Value = "xlRangeAutoFormatReport8"
-Range("B510").Value = 28
-Range("C510").Value = num
-B510 = Range("B510").Value
-C510 = Range("C510").Value
-If B510 = C510 Then
-Range("D510").Value = "OK"
-Else
-Range("D510").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatReport9(ByRef num)
-Range("A511").Clear
-Range("B511").Clear
-Range("C511").Clear
-Range("D511").Clear
-Range("A511").Value = "xlRangeAutoFormatReport9"
-Range("B511").Value = 29
-Range("C511").Value = num
-B511 = Range("B511").Value
-C511 = Range("C511").Value
-If B511 = C511 Then
-Range("D511").Value = "OK"
-Else
-Range("D511").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatSimple(ByRef num)
-Range("A512").Clear
-Range("B512").Clear
-Range("C512").Clear
-Range("D512").Clear
-Range("A512").Value = "xlRangeAutoFormatSimple"
-Range("B512").Value = -4154
-Range("C512").Value = num
-B512 = Range("B512").Value
-C512 = Range("C512").Value
-If B512 = C512 Then
-Range("D512").Value = "OK"
-Else
-Range("D512").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable1(ByRef num)
-Range("A513").Clear
-Range("B513").Clear
-Range("C513").Clear
-Range("D513").Clear
-Range("A513").Value = "xlRangeAutoFormatTable1"
-Range("B513").Value = 32
-Range("C513").Value = num
-B513 = Range("B513").Value
-C513 = Range("C513").Value
-If B513 = C513 Then
-Range("D513").Value = "OK"
-Else
-Range("D513").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable10(ByRef num)
-Range("A514").Clear
-Range("B514").Clear
-Range("C514").Clear
-Range("D514").Clear
-Range("A514").Value = "xlRangeAutoFormatTable10"
-Range("B514").Value = 41
-Range("C514").Value = num
-B514 = Range("B514").Value
-C514 = Range("C514").Value
-If B514 = C514 Then
-Range("D514").Value = "OK"
-Else
-Range("D514").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable2(ByRef num)
-Range("A515").Clear
-Range("B515").Clear
-Range("C515").Clear
-Range("D515").Clear
-Range("A515").Value = "xlRangeAutoFormatTable2"
-Range("B515").Value = 33
-Range("C515").Value = num
-B515 = Range("B515").Value
-C515 = Range("C515").Value
-If B515 = C515 Then
-Range("D515").Value = "OK"
-Else
-Range("D515").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable3(ByRef num)
-Range("A516").Clear
-Range("B516").Clear
-Range("C516").Clear
-Range("D516").Clear
-Range("A516").Value = "xlRangeAutoFormatTable3"
-Range("B516").Value = 34
-Range("C516").Value = num
-B516 = Range("B516").Value
-C516 = Range("C516").Value
-If B516 = C516 Then
-Range("D516").Value = "OK"
-Else
-Range("D516").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable4(ByRef num)
-Range("A517").Clear
-Range("B517").Clear
-Range("C517").Clear
-Range("D517").Clear
-Range("A517").Value = "xlRangeAutoFormatTable4"
-Range("B517").Value = 35
-Range("C517").Value = num
-B517 = Range("B517").Value
-C517 = Range("C517").Value
-If B517 = C517 Then
-Range("D517").Value = "OK"
-Else
-Range("D517").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable5(ByRef num)
-Range("A518").Clear
-Range("B518").Clear
-Range("C518").Clear
-Range("D518").Clear
-Range("A518").Value = "xlRangeAutoFormatTable5"
-Range("B518").Value = 36
-Range("C518").Value = num
-B518 = Range("B518").Value
-C518 = Range("C518").Value
-If B518 = C518 Then
-Range("D518").Value = "OK"
-Else
-Range("D518").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable6(ByRef num)
-Range("A519").Clear
-Range("B519").Clear
-Range("C519").Clear
-Range("D519").Clear
-Range("A519").Value = "xlRangeAutoFormatTable6"
-Range("B519").Value = 37
-Range("C519").Value = num
-B519 = Range("B519").Value
-C519 = Range("C519").Value
-If B519 = C519 Then
-Range("D519").Value = "OK"
-Else
-Range("D519").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable7(ByRef num)
-Range("A520").Clear
-Range("B520").Clear
-Range("C520").Clear
-Range("D520").Clear
-Range("A520").Value = "xlRangeAutoFormatTable7"
-Range("B520").Value = 38
-Range("C520").Value = num
-B520 = Range("B520").Value
-C520 = Range("C520").Value
-If B520 = C520 Then
-Range("D520").Value = "OK"
-Else
-Range("D520").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable8(ByRef num)
-Range("A521").Clear
-Range("B521").Clear
-Range("C521").Clear
-Range("D521").Clear
-Range("A521").Value = "xlRangeAutoFormatTable8"
-Range("B521").Value = 39
-Range("C521").Value = num
-B521 = Range("B521").Value
-C521 = Range("C521").Value
-If B521 = C521 Then
-Range("D521").Value = "OK"
-Else
-Range("D521").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeAutoFormatTable9(ByRef num)
-Range("A522").Clear
-Range("B522").Clear
-Range("C522").Clear
-Range("D522").Clear
-Range("A522").Value = "xlRangeAutoFormatTable9"
-Range("B522").Value = 40
-Range("C522").Value = num
-B522 = Range("B522").Value
-C522 = Range("C522").Value
-If B522 = C522 Then
-Range("D522").Value = "OK"
-Else
-Range("D522").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeValueDefault(ByRef num)
-Range("A523").Clear
-Range("B523").Clear
-Range("C523").Clear
-Range("D523").Clear
-Range("A523").Value = "xlRangeValueDefault"
-Range("B523").Value = 10
-Range("C523").Value = num
-B523 = Range("B523").Value
-C523 = Range("C523").Value
-If B523 = C523 Then
-Range("D523").Value = "OK"
-Else
-Range("D523").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeValueMSPersistXML(ByRef num)
-Range("A524").Clear
-Range("B524").Clear
-Range("C524").Clear
-Range("D524").Clear
-Range("A524").Value = "xlRangeValueMSPersistXML"
-Range("B524").Value = 12
-Range("C524").Value = num
-B524 = Range("B524").Value
-C524 = Range("C524").Value
-If B524 = C524 Then
-Range("D524").Value = "OK"
-Else
-Range("D524").Value = "NG"
-End If
-End Function
-
-Function test_xlRangeValueXMLSpreadsheet(ByRef num)
-Range("A525").Clear
-Range("B525").Clear
-Range("C525").Clear
-Range("D525").Clear
-Range("A525").Value = "xlRangeValueXMLSpreadsheet"
-Range("B525").Value = 11
-Range("C525").Value = num
-B525 = Range("B525").Value
-C525 = Range("C525").Value
-If B525 = C525 Then
-Range("D525").Value = "OK"
-Else
-Range("D525").Value = "NG"
-End If
-End Function
-
-Function test_xlA1(ByRef num)
-Range("A526").Clear
-Range("B526").Clear
-Range("C526").Clear
-Range("D526").Clear
-Range("A526").Value = "xlA1"
-Range("B526").Value = 1
-Range("C526").Value = num
-B526 = Range("B526").Value
-C526 = Range("C526").Value
-If B526 = C526 Then
-Range("D526").Value = "OK"
-Else
-Range("D526").Value = "NG"
-End If
-End Function
-
-Function test_xlR1C1(ByRef num)
-Range("A527").Clear
-Range("B527").Clear
-Range("C527").Clear
-Range("D527").Clear
-Range("A527").Value = "xlR1C1"
-Range("B527").Value = -4150
-Range("C527").Value = num
-B527 = Range("B527").Value
-C527 = Range("C527").Value
-If B527 = C527 Then
-Range("D527").Value = "OK"
-Else
-Range("D527").Value = "NG"
-End If
-End Function
-
-Function test_xlAbsolute(ByRef num)
-Range("A528").Clear
-Range("B528").Clear
-Range("C528").Clear
-Range("D528").Clear
-Range("A528").Value = "xlAbsolute"
-Range("B528").Value = 1
-Range("C528").Value = num
-B528 = Range("B528").Value
-C528 = Range("C528").Value
-If B528 = C528 Then
-Range("D528").Value = "OK"
-Else
-Range("D528").Value = "NG"
-End If
-End Function
-
-Function test_xlAbsRowRelColumn(ByRef num)
-Range("A529").Clear
-Range("B529").Clear
-Range("C529").Clear
-Range("D529").Clear
-Range("A529").Value = "xlAbsRowRelColumn"
-Range("B529").Value = 2
-Range("C529").Value = num
-B529 = Range("B529").Value
-C529 = Range("C529").Value
-If B529 = C529 Then
-Range("D529").Value = "OK"
-Else
-Range("D529").Value = "NG"
-End If
-End Function
-
-Function test_xlRelative(ByRef num)
-Range("A530").Clear
-Range("B530").Clear
-Range("C530").Clear
-Range("D530").Clear
-Range("A530").Value = "xlRelative"
-Range("B530").Value = 4
-Range("C530").Value = num
-B530 = Range("B530").Value
-C530 = Range("C530").Value
-If B530 = C530 Then
-Range("D530").Value = "OK"
-Else
-Range("D530").Value = "NG"
-End If
-End Function
-
-Function test_xlRelRowAbsColumn(ByRef num)
-Range("A531").Clear
-Range("B531").Clear
-Range("C531").Clear
-Range("D531").Clear
-Range("A531").Value = "xlRelRowAbsColumn"
-Range("B531").Value = 3
-Range("C531").Value = num
-B531 = Range("B531").Value
-C531 = Range("C531").Value
-If B531 = C531 Then
-Range("D531").Value = "OK"
-Else
-Range("D531").Value = "NG"
-End If
-End Function
-
-Function test_xlAlways(ByRef num)
-Range("A532").Clear
-Range("B532").Clear
-Range("C532").Clear
-Range("D532").Clear
-Range("A532").Value = "xlAlways"
-Range("B532").Value = 1
-Range("C532").Value = num
-B532 = Range("B532").Value
-C532 = Range("C532").Value
-If B532 = C532 Then
-Range("D532").Value = "OK"
-Else
-Range("D532").Value = "NG"
-End If
-End Function
-
-Function test_xlAsRequired(ByRef num)
-Range("A533").Clear
-Range("B533").Clear
-Range("C533").Clear
-Range("D533").Clear
-Range("A533").Value = "xlAsRequired"
-Range("B533").Value = 0
-Range("C533").Value = num
-B533 = Range("B533").Value
-C533 = Range("C533").Value
-If B533 = C533 Then
-Range("D533").Value = "OK"
-Else
-Range("D533").Value = "NG"
-End If
-End Function
-
-Function test_xlNever(ByRef num)
-Range("A534").Clear
-Range("B534").Clear
-Range("C534").Clear
-Range("D534").Clear
-Range("A534").Value = "xlNever"
-Range("B534").Value = 2
-Range("C534").Value = num
-B534 = Range("B534").Value
-C534 = Range("C534").Value
-If B534 = C534 Then
-Range("D534").Value = "OK"
-Else
-Range("D534").Value = "NG"
-End If
-End Function
-
-Function test_xlAllAtOnce(ByRef num)
-Range("A535").Clear
-Range("B535").Clear
-Range("C535").Clear
-Range("D535").Clear
-Range("A535").Value = "xlAllAtOnce"
-Range("B535").Value = 2
-Range("C535").Value = num
-B535 = Range("B535").Value
-C535 = Range("C535").Value
-If B535 = C535 Then
-Range("D535").Value = "OK"
-Else
-Range("D535").Value = "NG"
-End If
-End Function
-
-Function test_xlOneAfterAnother(ByRef num)
-Range("A536").Clear
-Range("B536").Clear
-Range("C536").Clear
-Range("D536").Clear
-Range("A536").Value = "xlOneAfterAnother"
-Range("B536").Value = 1
-Range("C536").Value = num
-B536 = Range("B536").Value
-C536 = Range("C536").Value
-If B536 = C536 Then
-Range("D536").Value = "OK"
-Else
-Range("D536").Value = "NG"
-End If
-End Function
-
-Function test_xlNotYetRouted(ByRef num)
-Range("A537").Clear
-Range("B537").Clear
-Range("C537").Clear
-Range("D537").Clear
-Range("A537").Value = "xlNotYetRouted"
-Range("B537").Value = 0
-Range("C537").Value = num
-B537 = Range("B537").Value
-C537 = Range("C537").Value
-If B537 = C537 Then
-Range("D537").Value = "OK"
-Else
-Range("D537").Value = "NG"
-End If
-End Function
-
-Function test_xlRoutingComplete(ByRef num)
-Range("A538").Clear
-Range("B538").Clear
-Range("C538").Clear
-Range("D538").Clear
-Range("A538").Value = "xlRoutingComplete"
-Range("B538").Value = 2
-Range("C538").Value = num
-B538 = Range("B538").Value
-C538 = Range("C538").Value
-If B538 = C538 Then
-Range("D538").Value = "OK"
-Else
-Range("D538").Value = "NG"
-End If
-End Function
-
-Function test_xlRoutingInProgress(ByRef num)
-Range("A539").Clear
-Range("B539").Clear
-Range("C539").Clear
-Range("D539").Clear
-Range("A539").Value = "xlRoutingInProgress"
-Range("B539").Value = 1
-Range("C539").Value = num
-B539 = Range("B539").Value
-C539 = Range("C539").Value
-If B539 = C539 Then
-Range("D539").Value = "OK"
-Else
-Range("D539").Value = "NG"
-End If
-End Function
-
-Function test_xlColumns(ByRef num)
-Range("A540").Clear
-Range("B540").Clear
-Range("C540").Clear
-Range("D540").Clear
-Range("A540").Value = "xlColumns"
-Range("B540").Value = 2
-Range("C540").Value = num
-B540 = Range("B540").Value
-C540 = Range("C540").Value
-If B540 = C540 Then
-Range("D540").Value = "OK"
-Else
-Range("D540").Value = "NG"
-End If
-End Function
-
-Function test_xlRows(ByRef num)
-Range("A541").Clear
-Range("B541").Clear
-Range("C541").Clear
-Range("D541").Clear
-Range("A541").Value = "xlRows"
-Range("B541").Value = 1
-Range("C541").Value = num
-B541 = Range("B541").Value
-C541 = Range("C541").Value
-If B541 = C541 Then
-Range("D541").Value = "OK"
-Else
-Range("D541").Value = "NG"
-End If
-End Function
-
-Function test_xlAutoActivate(ByRef num)
-Range("A542").Clear
-Range("B542").Clear
-Range("C542").Clear
-Range("D542").Clear
-Range("A542").Value = "xlAutoActivate"
-Range("B542").Value = 3
-Range("C542").Value = num
-B542 = Range("B542").Value
-C542 = Range("C542").Value
-If B542 = C542 Then
-Range("D542").Value = "OK"
-Else
-Range("D542").Value = "NG"
-End If
-End Function
-
-Function test_xlAutoClose(ByRef num)
-Range("A543").Clear
-Range("B543").Clear
-Range("C543").Clear
-Range("D543").Clear
-Range("A543").Value = "xlAutoClose"
-Range("B543").Value = 2
-Range("C543").Value = num
-B543 = Range("B543").Value
-C543 = Range("C543").Value
-If B543 = C543 Then
-Range("D543").Value = "OK"
-Else
-Range("D543").Value = "NG"
-End If
-End Function
-
-Function test_xlAutoDeactivate(ByRef num)
-Range("A544").Clear
-Range("B544").Clear
-Range("C544").Clear
-Range("D544").Clear
-Range("A544").Value = "xlAutoDeactivate"
-Range("B544").Value = 4
-Range("C544").Value = num
-B544 = Range("B544").Value
-C544 = Range("C544").Value
-If B544 = C544 Then
-Range("D544").Value = "OK"
-Else
-Range("D544").Value = "NG"
-End If
-End Function
-
-Function test_xlAutoOpen(ByRef num)
-Range("A545").Clear
-Range("B545").Clear
-Range("C545").Clear
-Range("D545").Clear
-Range("A545").Value = "xlAutoOpen"
-Range("B545").Value = 1
-Range("C545").Value = num
-B545 = Range("B545").Value
-C545 = Range("C545").Value
-If B545 = C545 Then
-Range("D545").Value = "OK"
-Else
-Range("D545").Value = "NG"
-End If
-End Function
-
-Function test_xlDoNotSaveChanges(ByRef num)
-Range("A546").Clear
-Range("B546").Clear
-Range("C546").Clear
-Range("D546").Clear
-Range("A546").Value = "xlDoNotSaveChanges"
-Range("B546").Value = 2
-Range("C546").Value = num
-B546 = Range("B546").Value
-C546 = Range("C546").Value
-If B546 = C546 Then
-Range("D546").Value = "OK"
-Else
-Range("D546").Value = "NG"
-End If
-End Function
-
-Function test_xlSaveChanges(ByRef num)
-Range("A547").Clear
-Range("B547").Clear
-Range("C547").Clear
-Range("D547").Clear
-Range("A547").Value = "xlSaveChanges"
-Range("B547").Value = 1
-Range("C547").Value = num
-B547 = Range("B547").Value
-C547 = Range("C547").Value
-If B547 = C547 Then
-Range("D547").Value = "OK"
-Else
-Range("D547").Value = "NG"
-End If
-End Function
-
-Function test_xlExclusive(ByRef num)
-Range("A548").Clear
-Range("B548").Clear
-Range("C548").Clear
-Range("D548").Clear
-Range("A548").Value = "xlExclusive"
-Range("B548").Value = 3
-Range("C548").Value = num
-B548 = Range("B548").Value
-C548 = Range("C548").Value
-If B548 = C548 Then
-Range("D548").Value = "OK"
-Else
-Range("D548").Value = "NG"
-End If
-End Function
-
-Function test_xlNoChange(ByRef num)
-Range("A549").Clear
-Range("B549").Clear
-Range("C549").Clear
-Range("D549").Clear
-Range("A549").Value = "xlNoChange"
-Range("B549").Value = 1
-Range("C549").Value = num
-B549 = Range("B549").Value
-C549 = Range("C549").Value
-If B549 = C549 Then
-Range("D549").Value = "OK"
-Else
-Range("D549").Value = "NG"
-End If
-End Function
-
-Function test_xlShared(ByRef num)
-Range("A550").Clear
-Range("B550").Clear
-Range("C550").Clear
-Range("D550").Clear
-Range("A550").Value = "xlShared"
-Range("B550").Value = 2
-Range("C550").Value = num
-B550 = Range("B550").Value
-C550 = Range("C550").Value
-If B550 = C550 Then
-Range("D550").Value = "OK"
-Else
-Range("D550").Value = "NG"
-End If
-End Function
-
-Function test_xlLocalSessionsChanges(ByRef num)
-Range("A551").Clear
-Range("B551").Clear
-Range("C551").Clear
-Range("D551").Clear
-Range("A551").Value = "xlLocalSessionsChanges"
-Range("B551").Value = 2
-Range("C551").Value = num
-B551 = Range("B551").Value
-C551 = Range("C551").Value
-If B551 = C551 Then
-Range("D551").Value = "OK"
-Else
-Range("D551").Value = "NG"
-End If
-End Function
-
-Function test_xlOtherSessionsChanges(ByRef num)
-Range("A552").Clear
-Range("B552").Clear
-Range("C552").Clear
-Range("D552").Clear
-Range("A552").Value = "xlOtherSessionsChanges"
-Range("B552").Value = 3
-Range("C552").Value = num
-B552 = Range("B552").Value
-C552 = Range("C552").Value
-If B552 = C552 Then
-Range("D552").Value = "OK"
-Else
-Range("D552").Value = "NG"
-End If
-End Function
-
-Function test_xlUserResolution(ByRef num)
-Range("A553").Clear
-Range("B553").Clear
-Range("C553").Clear
-Range("D553").Clear
-Range("A553").Value = "xlUserResolution"
-Range("B553").Value = 1
-Range("C553").Value = num
-B553 = Range("B553").Value
-C553 = Range("C553").Value
-If B553 = C553 Then
-Range("D553").Value = "OK"
-Else
-Range("D553").Value = "NG"
-End If
-End Function
-
-Function test_xlScaleLinear(ByRef num)
-Range("A554").Clear
-Range("B554").Clear
-Range("C554").Clear
-Range("D554").Clear
-Range("A554").Value = "xlScaleLinear"
-Range("B554").Value = -4132
-Range("C554").Value = num
-B554 = Range("B554").Value
-C554 = Range("C554").Value
-If B554 = C554 Then
-Range("D554").Value = "OK"
-Else
-Range("D554").Value = "NG"
-End If
-End Function
-
-Function test_xlScaleLogarithmicr(ByRef num)
-Range("A555").Clear
-Range("B555").Clear
-Range("C555").Clear
-Range("D555").Clear
-Range("A555").Value = "xlScaleLogarithmicr"
-Range("B555").Value = -4133
-Range("C555").Value = num
-B555 = Range("B555").Value
-C555 = Range("C555").Value
-If B555 = C555 Then
-Range("D555").Value = "OK"
-Else
-Range("D555").Value = "NG"
-End If
-End Function
-
-Function test_xlNext(ByRef num)
-Range("A556").Clear
-Range("B556").Clear
-Range("C556").Clear
-Range("D556").Clear
-Range("A556").Value = "xlNext"
-Range("B556").Value = 1
-Range("C556").Value = num
-B556 = Range("B556").Value
-C556 = Range("C556").Value
-If B556 = C556 Then
-Range("D556").Value = "OK"
-Else
-Range("D556").Value = "NG"
-End If
-End Function
-
-Function test_xlPrevious(ByRef num)
-Range("A557").Clear
-Range("B557").Clear
-Range("C557").Clear
-Range("D557").Clear
-Range("A557").Value = "xlPrevious"
-Range("B557").Value = 2
-Range("C557").Value = num
-B557 = Range("B557").Value
-C557 = Range("C557").Value
-If B557 = C557 Then
-Range("D557").Value = "OK"
-Else
-Range("D557").Value = "NG"
-End If
-End Function
-
-Function test_xlByColumns(ByRef num)
-Range("A558").Clear
-Range("B558").Clear
-Range("C558").Clear
-Range("D558").Clear
-Range("A558").Value = "xlByColumns"
-Range("B558").Value = 2
-Range("C558").Value = num
-B558 = Range("B558").Value
-C558 = Range("C558").Value
-If B558 = C558 Then
-Range("D558").Value = "OK"
-Else
-Range("D558").Value = "NG"
-End If
-End Function
-
-Function test_xlByRows(ByRef num)
-Range("A559").Clear
-Range("B559").Clear
-Range("C559").Clear
-Range("D559").Clear
-Range("A559").Value = "xlByRows"
-Range("B559").Value = 1
-Range("C559").Value = num
-B559 = Range("B559").Value
-C559 = Range("C559").Value
-If B559 = C559 Then
-Range("D559").Value = "OK"
-Else
-Range("D559").Value = "NG"
-End If
-End Function
-
-Function test_xlWithinSheet(ByRef num)
-Range("A560").Clear
-Range("B560").Clear
-Range("C560").Clear
-Range("D560").Clear
-Range("A560").Value = "xlWithinSheet"
-Range("B560").Value = 1
-Range("C560").Value = num
-B560 = Range("B560").Value
-C560 = Range("C560").Value
-If B560 = C560 Then
-Range("D560").Value = "OK"
-Else
-Range("D560").Value = "NG"
-End If
-End Function
-
-Function test_xlWithinWorkbook(ByRef num)
-Range("A561").Clear
-Range("B561").Clear
-Range("C561").Clear
-Range("D561").Clear
-Range("A561").Value = "xlWithinWorkbook"
-Range("B561").Value = 2
-Range("C561").Value = num
-B561 = Range("B561").Value
-C561 = Range("C561").Value
-If B561 = C561 Then
-Range("D561").Value = "OK"
-Else
-Range("D561").Value = "NG"
-End If
-End Function
-
-Function test_xlChart(ByRef num)
-Range("A562").Clear
-Range("B562").Clear
-Range("C562").Clear
-Range("D562").Clear
-Range("A562").Value = "xlChart"
-Range("B562").Value = -4109
-Range("C562").Value = num
-B562 = Range("B562").Value
-C562 = Range("C562").Value
-If B562 = C562 Then
-Range("D562").Value = "OK"
-Else
-Range("D562").Value = "NG"
-End If
-End Function
-
-Function test_xlDialogSheet(ByRef num)
-Range("A563").Clear
-Range("B563").Clear
-Range("C563").Clear
-Range("D563").Clear
-Range("A563").Value = "xlDialogSheet"
-Range("B563").Value = -4116
-Range("C563").Value = num
-B563 = Range("B563").Value
-C563 = Range("C563").Value
-If B563 = C563 Then
-Range("D563").Value = "OK"
-Else
-Range("D563").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel4IntMacroSheet(ByRef num)
-Range("A564").Clear
-Range("B564").Clear
-Range("C564").Clear
-Range("D564").Clear
-Range("A564").Value = "xlExcel4IntMacroSheet"
-Range("B564").Value = 4
-Range("C564").Value = num
-B564 = Range("B564").Value
-C564 = Range("C564").Value
-If B564 = C564 Then
-Range("D564").Value = "OK"
-Else
-Range("D564").Value = "NG"
-End If
-End Function
-
-Function test_xlExcel4MacroSheet(ByRef num)
-Range("A565").Clear
-Range("B565").Clear
-Range("C565").Clear
-Range("D565").Clear
-Range("A565").Value = "xlExcel4MacroSheet"
-Range("B565").Value = 3
-Range("C565").Value = num
-B565 = Range("B565").Value
-C565 = Range("C565").Value
-If B565 = C565 Then
-Range("D565").Value = "OK"
-Else
-Range("D565").Value = "NG"
-End If
-End Function
-
-Function test_xlWorkSheet(ByRef num)
-Range("A566").Clear
-Range("B566").Clear
-Range("C566").Clear
-Range("D566").Clear
-Range("A566").Value = "xlWorkSheet"
-Range("B566").Value = -4167
-Range("C566").Value = num
-B566 = Range("B566").Value
-C566 = Range("C566").Value
-If B566 = C566 Then
-Range("D566").Value = "OK"
-Else
-Range("D566").Value = "NG"
-End If
-End Function
-
-Function test_xlSheetHidden(ByRef num)
-Range("A567").Clear
-Range("B567").Clear
-Range("C567").Clear
-Range("D567").Clear
-Range("A567").Value = "xlSheetHidden"
-Range("B567").Value = 0
-Range("C567").Value = num
-B567 = Range("B567").Value
-C567 = Range("C567").Value
-If B567 = C567 Then
-Range("D567").Value = "OK"
-Else
-Range("D567").Value = "NG"
-End If
-End Function
-
-Function test_xlSheetVeryHidden(ByRef num)
-Range("A568").Clear
-Range("B568").Clear
-Range("C568").Clear
-Range("D568").Clear
-Range("A568").Value = "xlSheetVeryHidden"
-Range("B568").Value = 2
-Range("C568").Value = num
-B568 = Range("B568").Value
-C568 = Range("C568").Value
-If B568 = C568 Then
-Range("D568").Value = "OK"
-Else
-Range("D568").Value = "NG"
-End If
-End Function
-
-Function test_xlSheetVisible(ByRef num)
-Range("A569").Clear
-Range("B569").Clear
-Range("C569").Clear
-Range("D569").Clear
-Range("A569").Value = "xlSheetVisible"
-Range("B569").Value = -1
-Range("C569").Value = num
-B569 = Range("B569").Value
-C569 = Range("C569").Value
-If B569 = C569 Then
-Range("D569").Value = "OK"
-Else
-Range("D569").Value = "NG"
-End If
-End Function
-
-Function test_xlSizeIsArea(ByRef num)
-Range("A570").Clear
-Range("B570").Clear
-Range("C570").Clear
-Range("D570").Clear
-Range("A570").Value = "xlSizeIsArea"
-Range("B570").Value = 1
-Range("C570").Value = num
-B570 = Range("B570").Value
-C570 = Range("C570").Value
-If B570 = C570 Then
-Range("D570").Value = "OK"
-Else
-Range("D570").Value = "NG"
-End If
-End Function
-
-Function test_xlSizeIsWidth(ByRef num)
-Range("A571").Clear
-Range("B571").Clear
-Range("C571").Clear
-Range("D571").Clear
-Range("A571").Value = "xlSizeIsWidth"
-Range("B571").Value = 2
-Range("C571").Value = num
-B571 = Range("B571").Value
-C571 = Range("C571").Value
-If B571 = C571 Then
-Range("D571").Value = "OK"
-Else
-Range("D571").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlActiveX(ByRef num)
-Range("A572").Clear
-Range("B572").Clear
-Range("C572").Clear
-Range("D572").Clear
-Range("A572").Value = "xlSmartTagControlActiveX"
-Range("B572").Value = 13
-Range("C572").Value = num
-B572 = Range("B572").Value
-C572 = Range("C572").Value
-If B572 = C572 Then
-Range("D572").Value = "OK"
-Else
-Range("D572").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlButton(ByRef num)
-Range("A573").Clear
-Range("B573").Clear
-Range("C573").Clear
-Range("D573").Clear
-Range("A573").Value = "xlSmartTagControlButton"
-Range("B573").Value = 6
-Range("C573").Value = num
-B573 = Range("B573").Value
-C573 = Range("C573").Value
-If B573 = C573 Then
-Range("D573").Value = "OK"
-Else
-Range("D573").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlCheckbox(ByRef num)
-Range("A574").Clear
-Range("B574").Clear
-Range("C574").Clear
-Range("D574").Clear
-Range("A574").Value = "xlSmartTagControlCheckbox"
-Range("B574").Value = 9
-Range("C574").Value = num
-B574 = Range("B574").Value
-C574 = Range("C574").Value
-If B574 = C574 Then
-Range("D574").Value = "OK"
-Else
-Range("D574").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlCombo(ByRef num)
-Range("A575").Clear
-Range("B575").Clear
-Range("C575").Clear
-Range("D575").Clear
-Range("A575").Value = "xlSmartTagControlCombo"
-Range("B575").Value = 12
-Range("C575").Value = num
-B575 = Range("B575").Value
-C575 = Range("C575").Value
-If B575 = C575 Then
-Range("D575").Value = "OK"
-Else
-Range("D575").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlHelp(ByRef num)
-Range("A576").Clear
-Range("B576").Clear
-Range("C576").Clear
-Range("D576").Clear
-Range("A576").Value = "xlSmartTagControlHelp"
-Range("B576").Value = 3
-Range("C576").Value = num
-B576 = Range("B576").Value
-C576 = Range("C576").Value
-If B576 = C576 Then
-Range("D576").Value = "OK"
-Else
-Range("D576").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlHelpURL(ByRef num)
-Range("A577").Clear
-Range("B577").Clear
-Range("C577").Clear
-Range("D577").Clear
-Range("A577").Value = "xlSmartTagControlHelpURL"
-Range("B577").Value = 4
-Range("C577").Value = num
-B577 = Range("B577").Value
-C577 = Range("C577").Value
-If B577 = C577 Then
-Range("D577").Value = "OK"
-Else
-Range("D577").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlImage(ByRef num)
-Range("A578").Clear
-Range("B578").Clear
-Range("C578").Clear
-Range("D578").Clear
-Range("A578").Value = "xlSmartTagControlImage"
-Range("B578").Value = 8
-Range("C578").Value = num
-B578 = Range("B578").Value
-C578 = Range("C578").Value
-If B578 = C578 Then
-Range("D578").Value = "OK"
-Else
-Range("D578").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlLabel(ByRef num)
-Range("A579").Clear
-Range("B579").Clear
-Range("C579").Clear
-Range("D579").Clear
-Range("A579").Value = "xlSmartTagControlLabel"
-Range("B579").Value = 7
-Range("C579").Value = num
-B579 = Range("B579").Value
-C579 = Range("C579").Value
-If B579 = C579 Then
-Range("D579").Value = "OK"
-Else
-Range("D579").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlLink(ByRef num)
-Range("A580").Clear
-Range("B580").Clear
-Range("C580").Clear
-Range("D580").Clear
-Range("A580").Value = "xlSmartTagControlLink"
-Range("B580").Value = 2
-Range("C580").Value = num
-B580 = Range("B580").Value
-C580 = Range("C580").Value
-If B580 = C580 Then
-Range("D580").Value = "OK"
-Else
-Range("D580").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlListbox(ByRef num)
-Range("A581").Clear
-Range("B581").Clear
-Range("C581").Clear
-Range("D581").Clear
-Range("A581").Value = "xlSmartTagControlListbox"
-Range("B581").Value = 11
-Range("C581").Value = num
-B581 = Range("B581").Value
-C581 = Range("C581").Value
-If B581 = C581 Then
-Range("D581").Value = "OK"
-Else
-Range("D581").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlRadioGroup(ByRef num)
-Range("A582").Clear
-Range("B582").Clear
-Range("C582").Clear
-Range("D582").Clear
-Range("A582").Value = "xlSmartTagControlRadioGroup"
-Range("B582").Value = 14
-Range("C582").Value = num
-B582 = Range("B582").Value
-C582 = Range("C582").Value
-If B582 = C582 Then
-Range("D582").Value = "OK"
-Else
-Range("D582").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlSeparator(ByRef num)
-Range("A583").Clear
-Range("B583").Clear
-Range("C583").Clear
-Range("D583").Clear
-Range("A583").Value = "xlSmartTagControlSeparator"
-Range("B583").Value = 5
-Range("C583").Value = num
-B583 = Range("B583").Value
-C583 = Range("C583").Value
-If B583 = C583 Then
-Range("D583").Value = "OK"
-Else
-Range("D583").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlSmartTag(ByRef num)
-Range("A584").Clear
-Range("B584").Clear
-Range("C584").Clear
-Range("D584").Clear
-Range("A584").Value = "xlSmartTagControlSmartTag"
-Range("B584").Value = 1
-Range("C584").Value = num
-B584 = Range("B584").Value
-C584 = Range("C584").Value
-If B584 = C584 Then
-Range("D584").Value = "OK"
-Else
-Range("D584").Value = "NG"
-End If
-End Function
-
-Function test_xlSmartTagControlTextbox(ByRef num)
-Range("A585").Clear
-Range("B585").Clear
-Range("C585").Clear
-Range("D585").Clear
-Range("A585").Value = "xlSmartTagControlTextbox"
-Range("B585").Value = 10
-Range("C585").Value = num
-B585 = Range("B585").Value
-C585 = Range("C585").Value
-If B585 = C585 Then
-Range("D585").Value = "OK"
-Else
-Range("D585").Value = "NG"
-End If
-End Function
-
-Function test_xlButtonOnly(ByRef num)
-Range("A586").Clear
-Range("B586").Clear
-Range("C586").Clear
-Range("D586").Clear
-Range("A586").Value = "xlButtonOnly"
-Range("B586").Value = 2
-Range("C586").Value = num
-B586 = Range("B586").Value
-C586 = Range("C586").Value
-If B586 = C586 Then
-Range("D586").Value = "OK"
-Else
-Range("D586").Value = "NG"
-End If
-End Function
-
-Function test_xlDisplayNone(ByRef num)
-Range("A587").Clear
-Range("B587").Clear
-Range("C587").Clear
-Range("D587").Clear
-Range("A587").Value = "xlDisplayNone"
-Range("B587").Value = 1
-Range("C587").Value = num
-B587 = Range("B587").Value
-C587 = Range("C587").Value
-If B587 = C587 Then
-Range("D587").Value = "OK"
-Else
-Range("D587").Value = "NG"
-End If
-End Function
-
-Function test_xlIndicatorAndButton(ByRef num)
-Range("A588").Clear
-Range("B588").Clear
-Range("C588").Clear
-Range("D588").Clear
-Range("A588").Value = "xlIndicatorAndButton"
-Range("B588").Value = 0
-Range("C588").Value = num
-B588 = Range("B588").Value
-C588 = Range("C588").Value
-If B588 = C588 Then
-Range("D588").Value = "OK"
-Else
-Range("D588").Value = "NG"
-End If
-End Function
-
-Function test_xlSortNormal(ByRef num)
-Range("A589").Clear
-Range("B589").Clear
-Range("C589").Clear
-Range("D589").Clear
-Range("A589").Value = "xlSortNormal"
-Range("B589").Value = 0
-Range("C589").Value = num
-B589 = Range("B589").Value
-C589 = Range("C589").Value
-If B589 = C589 Then
-Range("D589").Value = "OK"
-Else
-Range("D589").Value = "NG"
-End If
-End Function
-
-Function test_xlSortTextAsNumbers(ByRef num)
-Range("A590").Clear
-Range("B590").Clear
-Range("C590").Clear
-Range("D590").Clear
-Range("A590").Value = "xlSortTextAsNumbers"
-Range("B590").Value = 1
-Range("C590").Value = num
-B590 = Range("B590").Value
-C590 = Range("C590").Value
-If B590 = C590 Then
-Range("D590").Value = "OK"
-Else
-Range("D590").Value = "NG"
-End If
-End Function
-
-Function test_xlPinYin(ByRef num)
-Range("A591").Clear
-Range("B591").Clear
-Range("C591").Clear
-Range("D591").Clear
-Range("A591").Value = "xlPinYin"
-Range("B591").Value = 1
-Range("C591").Value = num
-B591 = Range("B591").Value
-C591 = Range("C591").Value
-If B591 = C591 Then
-Range("D591").Value = "OK"
-Else
-Range("D591").Value = "NG"
-End If
-End Function
-
-Function test_xlStroke(ByRef num)
-Range("A592").Clear
-Range("B592").Clear
-Range("C592").Clear
-Range("D592").Clear
-Range("A592").Value = "xlStroke"
-Range("B592").Value = 2
-Range("C592").Value = num
-B592 = Range("B592").Value
-C592 = Range("C592").Value
-If B592 = C592 Then
-Range("D592").Value = "OK"
-Else
-Range("D592").Value = "NG"
-End If
-End Function
-
-Function test_xlCodePage(ByRef num)
-Range("A593").Clear
-Range("B593").Clear
-Range("C593").Clear
-Range("D593").Clear
-Range("A593").Value = "xlCodePage"
-Range("B593").Value = 2
-Range("C593").Value = num
-B593 = Range("B593").Value
-C593 = Range("C593").Value
-If B593 = C593 Then
-Range("D593").Value = "OK"
-Else
-Range("D593").Value = "NG"
-End If
-End Function
-
-Function test_xlSyllabary(ByRef num)
-Range("A594").Clear
-Range("B594").Clear
-Range("C594").Clear
-Range("D594").Clear
-Range("A594").Value = "xlSyllabary"
-Range("B594").Value = 1
-Range("C594").Value = num
-B594 = Range("B594").Value
-C594 = Range("C594").Value
-If B594 = C594 Then
-Range("D594").Value = "OK"
-Else
-Range("D594").Value = "NG"
-End If
-End Function
-
-Function test_xlAscending(ByRef num)
-Range("A595").Clear
-Range("B595").Clear
-Range("C595").Clear
-Range("D595").Clear
-Range("A595").Value = "xlAscending"
-Range("B595").Value = 1
-Range("C595").Value = num
-B595 = Range("B595").Value
-C595 = Range("C595").Value
-If B595 = C595 Then
-Range("D595").Value = "OK"
-Else
-Range("D595").Value = "NG"
-End If
-End Function
-
-Function test_xlDescending(ByRef num)
-Range("A596").Clear
-Range("B596").Clear
-Range("C596").Clear
-Range("D596").Clear
-Range("A596").Value = "xlDescending"
-Range("B596").Value = 2
-Range("C596").Value = num
-B596 = Range("B596").Value
-C596 = Range("C596").Value
-If B596 = C596 Then
-Range("D596").Value = "OK"
-Else
-Range("D596").Value = "NG"
-End If
-End Function
-
-Function test_xlSortColumns(ByRef num)
-Range("A597").Clear
-Range("B597").Clear
-Range("C597").Clear
-Range("D597").Clear
-Range("A597").Value = "xlSortColumns"
-Range("B597").Value = 1
-Range("C597").Value = num
-B597 = Range("B597").Value
-C597 = Range("C597").Value
-If B597 = C597 Then
-Range("D597").Value = "OK"
-Else
-Range("D597").Value = "NG"
-End If
-End Function
-
-Function test_xlSortRows(ByRef num)
-Range("A598").Clear
-Range("B598").Clear
-Range("C598").Clear
-Range("D598").Clear
-Range("A598").Value = "xlSortRows"
-Range("B598").Value = 2
-Range("C598").Value = num
-B598 = Range("B598").Value
-C598 = Range("C598").Value
-If B598 = C598 Then
-Range("D598").Value = "OK"
-Else
-Range("D598").Value = "NG"
-End If
-End Function
-
-Function test_xlSortLabels(ByRef num)
-Range("A599").Clear
-Range("B599").Clear
-Range("C599").Clear
-Range("D599").Clear
-Range("A599").Value = "xlSortLabels"
-Range("B599").Value = 2
-Range("C599").Value = num
-B599 = Range("B599").Value
-C599 = Range("C599").Value
-If B599 = C599 Then
-Range("D599").Value = "OK"
-Else
-Range("D599").Value = "NG"
-End If
-End Function
-
-Function test_xlSortValues(ByRef num)
-Range("A600").Clear
-Range("B600").Clear
-Range("C600").Clear
-Range("D600").Clear
-Range("A600").Value = "xlSortValues"
-Range("B600").Value = 1
-Range("C600").Value = num
-B600 = Range("B600").Value
-C600 = Range("C600").Value
-If B600 = C600 Then
-Range("D600").Value = "OK"
-Else
-Range("D600").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceAutoFilter(ByRef num)
-Range("A601").Clear
-Range("B601").Clear
-Range("C601").Clear
-Range("D601").Clear
-Range("A601").Value = "xlSourceAutoFilter"
-Range("B601").Value = 3
-Range("C601").Value = num
-B601 = Range("B601").Value
-C601 = Range("C601").Value
-If B601 = C601 Then
-Range("D601").Value = "OK"
-Else
-Range("D601").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceChart(ByRef num)
-Range("A602").Clear
-Range("B602").Clear
-Range("C602").Clear
-Range("D602").Clear
-Range("A602").Value = "xlSourceChart"
-Range("B602").Value = 5
-Range("C602").Value = num
-B602 = Range("B602").Value
-C602 = Range("C602").Value
-If B602 = C602 Then
-Range("D602").Value = "OK"
-Else
-Range("D602").Value = "NG"
-End If
-End Function
-
-Function test_xlSourcePivotTable(ByRef num)
-Range("A603").Clear
-Range("B603").Clear
-Range("C603").Clear
-Range("D603").Clear
-Range("A603").Value = "xlSourcePivotTable"
-Range("B603").Value = 6
-Range("C603").Value = num
-B603 = Range("B603").Value
-C603 = Range("C603").Value
-If B603 = C603 Then
-Range("D603").Value = "OK"
-Else
-Range("D603").Value = "NG"
-End If
-End Function
-
-Function test_xlSourcePrintArea(ByRef num)
-Range("A604").Clear
-Range("B604").Clear
-Range("C604").Clear
-Range("D604").Clear
-Range("A604").Value = "xlSourcePrintArea"
-Range("B604").Value = 2
-Range("C604").Value = num
-B604 = Range("B604").Value
-C604 = Range("C604").Value
-If B604 = C604 Then
-Range("D604").Value = "OK"
-Else
-Range("D604").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceQuery(ByRef num)
-Range("A605").Clear
-Range("B605").Clear
-Range("C605").Clear
-Range("D605").Clear
-Range("A605").Value = "xlSourceQuery"
-Range("B605").Value = 7
-Range("C605").Value = num
-B605 = Range("B605").Value
-C605 = Range("C605").Value
-If B605 = C605 Then
-Range("D605").Value = "OK"
-Else
-Range("D605").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceRange(ByRef num)
-Range("A606").Clear
-Range("B606").Clear
-Range("C606").Clear
-Range("D606").Clear
-Range("A606").Value = "xlSourceRange"
-Range("B606").Value = 4
-Range("C606").Value = num
-B606 = Range("B606").Value
-C606 = Range("C606").Value
-If B606 = C606 Then
-Range("D606").Value = "OK"
-Else
-Range("D606").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceSheet(ByRef num)
-Range("A607").Clear
-Range("B607").Clear
-Range("C607").Clear
-Range("D607").Clear
-Range("A607").Value = "xlSourceSheet"
-Range("B607").Value = 1
-Range("C607").Value = num
-B607 = Range("B607").Value
-C607 = Range("C607").Value
-If B607 = C607 Then
-Range("D607").Value = "OK"
-Else
-Range("D607").Value = "NG"
-End If
-End Function
-
-Function test_xlSourceWordbook(ByRef num)
-Range("A608").Clear
-Range("B608").Clear
-Range("C608").Clear
-Range("D608").Clear
-Range("A608").Value = "xlSourceWordbook"
-Range("B608").Value = 0
-Range("C608").Value = num
-B608 = Range("B608").Value
-C608 = Range("C608").Value
-If B608 = C608 Then
-Range("D608").Value = "OK"
-Else
-Range("D608").Value = "NG"
-End If
-End Function
-
-Function test_xlSpeakByColumns(ByRef num)
-Range("A609").Clear
-Range("B609").Clear
-Range("C609").Clear
-Range("D609").Clear
-Range("A609").Value = "xlSpeakByColumns"
-Range("B609").Value = 1
-Range("C609").Value = num
-B609 = Range("B609").Value
-C609 = Range("C609").Value
-If B609 = C609 Then
-Range("D609").Value = "OK"
-Else
-Range("D609").Value = "NG"
-End If
-End Function
-
-Function test_xlSpeakByRows(ByRef num)
-Range("A610").Clear
-Range("B610").Clear
-Range("C610").Clear
-Range("D610").Clear
-Range("A610").Value = "xlSpeakByRows"
-Range("B610").Value = 0
-Range("C610").Value = num
-B610 = Range("B610").Value
-C610 = Range("C610").Value
-If B610 = C610 Then
-Range("D610").Value = "OK"
-Else
-Range("D610").Value = "NG"
-End If
-End Function
-
-Function test_xlErrors(ByRef num)
-Range("A611").Clear
-Range("B611").Clear
-Range("C611").Clear
-Range("D611").Clear
-Range("A611").Value = "xlErrors"
-Range("B611").Value = 16
-Range("C611").Value = num
-B611 = Range("B611").Value
-C611 = Range("C611").Value
-If B611 = C611 Then
-Range("D611").Value = "OK"
-Else
-Range("D611").Value = "NG"
-End If
-End Function
-
-Function test_xlLogical(ByRef num)
-Range("A612").Clear
-Range("B612").Clear
-Range("C612").Clear
-Range("D612").Clear
-Range("A612").Value = "xlLogical"
-Range("B612").Value = 4
-Range("C612").Value = num
-B612 = Range("B612").Value
-C612 = Range("C612").Value
-If B612 = C612 Then
-Range("D612").Value = "OK"
-Else
-Range("D612").Value = "NG"
-End If
-End Function
-
-Function test_xlNumbers(ByRef num)
-Range("A613").Clear
-Range("B613").Clear
-Range("C613").Clear
-Range("D613").Clear
-Range("A613").Value = "xlNumbers"
-Range("B613").Value = 1
-Range("C613").Value = num
-B613 = Range("B613").Value
-C613 = Range("C613").Value
-If B613 = C613 Then
-Range("D613").Value = "OK"
-Else
-Range("D613").Value = "NG"
-End If
-End Function
-
-Function test_xlTextValues(ByRef num)
-Range("A614").Clear
-Range("B614").Clear
-Range("C614").Clear
-Range("D614").Clear
-Range("A614").Value = "xlTextValues"
-Range("B614").Value = 2
-Range("C614").Value = num
-B614 = Range("B614").Value
-C614 = Range("C614").Value
-If B614 = C614 Then
-Range("D614").Value = "OK"
-Else
-Range("D614").Value = "NG"
-End If
-End Function
-
-Function test_xlSubscribeToPicture(ByRef num)
-Range("A615").Clear
-Range("B615").Clear
-Range("C615").Clear
-Range("D615").Clear
-Range("A615").Value = "xlSubscribeToPicture"
-Range("B615").Value = -4147
-Range("C615").Value = num
-B615 = Range("B615").Value
-C615 = Range("C615").Value
-If B615 = C615 Then
-Range("D615").Value = "OK"
-Else
-Range("D615").Value = "NG"
-End If
-End Function
-
-Function test_xlSubscribeToText(ByRef num)
-Range("A616").Clear
-Range("B616").Clear
-Range("C616").Clear
-Range("D616").Clear
-Range("A616").Value = "xlSubscribeToText"
-Range("B616").Value = -4158
-Range("C616").Value = num
-B616 = Range("B616").Value
-C616 = Range("C616").Value
-If B616 = C616 Then
-Range("D616").Value = "OK"
-Else
-Range("D616").Value = "NG"
-End If
-End Function
-
-Function test_xlAtBottom(ByRef num)
-Range("A617").Clear
-Range("B617").Clear
-Range("C617").Clear
-Range("D617").Clear
-Range("A617").Value = "xlAtBottom"
-Range("B617").Value = 2
-Range("C617").Value = num
-B617 = Range("B617").Value
-C617 = Range("C617").Value
-If B617 = C617 Then
-Range("D617").Value = "OK"
-Else
-Range("D617").Value = "NG"
-End If
-End Function
-
-Function test_xlAtTop(ByRef num)
-Range("A618").Clear
-Range("B618").Clear
-Range("C618").Clear
-Range("D618").Clear
-Range("A618").Value = "xlAtTop"
-Range("B618").Value = 1
-Range("C618").Value = num
-B618 = Range("B618").Value
-C618 = Range("C618").Value
-If B618 = C618 Then
-Range("D618").Value = "OK"
-Else
-Range("D618").Value = "NG"
-End If
-End Function
-
-Function test_xlSummaryOnLeft(ByRef num)
-Range("A619").Clear
-Range("B619").Clear
-Range("C619").Clear
-Range("D619").Clear
-Range("A619").Value = "xlSummaryOnLeft"
-Range("B619").Value = -4131
-Range("C619").Value = num
-B619 = Range("B619").Value
-C619 = Range("C619").Value
-If B619 = C619 Then
-Range("D619").Value = "OK"
-Else
-Range("D619").Value = "NG"
-End If
-End Function
-
-Function test_xlSummaryOnRight(ByRef num)
-Range("A620").Clear
-Range("B620").Clear
-Range("C620").Clear
-Range("D620").Clear
-Range("A620").Value = "xlSummaryOnRight"
-Range("B620").Value = -4152
-Range("C620").Value = num
-B620 = Range("B620").Value
-C620 = Range("C620").Value
-If B620 = C620 Then
-Range("D620").Value = "OK"
-Else
-Range("D620").Value = "NG"
-End If
-End Function
-
-Function test_xlStandardSummary(ByRef num)
-Range("A621").Clear
-Range("B621").Clear
-Range("C621").Clear
-Range("D621").Clear
-Range("A621").Value = "xlStandardSummary"
-Range("B621").Value = 1
-Range("C621").Value = num
-B621 = Range("B621").Value
-C621 = Range("C621").Value
-If B621 = C621 Then
-Range("D621").Value = "OK"
-Else
-Range("D621").Value = "NG"
-End If
-End Function
-
-Function test_xlSummaryPivotTable(ByRef num)
-Range("A622").Clear
-Range("B622").Clear
-Range("C622").Clear
-Range("D622").Clear
-Range("A622").Value = "xlSummaryPivotTable"
-Range("B622").Value = -4148
-Range("C622").Value = num
-B622 = Range("B622").Value
-C622 = Range("C622").Value
-If B622 = C622 Then
-Range("D622").Value = "OK"
-Else
-Range("D622").Value = "NG"
-End If
-End Function
-
-Function test_xlSummaryAbove(ByRef num)
-Range("A623").Clear
-Range("B623").Clear
-Range("C623").Clear
-Range("D623").Clear
-Range("A623").Value = "xlSummaryAbove"
-Range("B623").Value = 0
-Range("C623").Value = num
-B623 = Range("B623").Value
-C623 = Range("C623").Value
-If B623 = C623 Then
-Range("D623").Value = "OK"
-Else
-Range("D623").Value = "NG"
-End If
-End Function
-
-Function test_xlSummaryBelow(ByRef num)
-Range("A624").Clear
-Range("B624").Clear
-Range("C624").Clear
-Range("D624").Clear
-Range("A624").Value = "xlSummaryBelow"
-Range("B624").Value = 1
-Range("C624").Value = num
-B624 = Range("B624").Value
-C624 = Range("C624").Value
-If B624 = C624 Then
-Range("D624").Value = "OK"
-Else
-Range("D624").Value = "NG"
-End If
-End Function
-
-Function test_xlTabPositionFirst(ByRef num)
-Range("A625").Clear
-Range("B625").Clear
-Range("C625").Clear
-Range("D625").Clear
-Range("A625").Value = "xlTabPositionFirst"
-Range("B625").Value = 0
-Range("C625").Value = num
-B625 = Range("B625").Value
-C625 = Range("C625").Value
-If B625 = C625 Then
-Range("D625").Value = "OK"
-Else
-Range("D625").Value = "NG"
-End If
-End Function
-
-Function test_xlTabPositionLast(ByRef num)
-Range("A626").Clear
-Range("B626").Clear
-Range("C626").Clear
-Range("D626").Clear
-Range("A626").Value = "xlTabPositionLast"
-Range("B626").Value = 1
-Range("C626").Value = num
-B626 = Range("B626").Value
-C626 = Range("C626").Value
-If B626 = C626 Then
-Range("D626").Value = "OK"
-Else
-Range("D626").Value = "NG"
-End If
-End Function
-
-Function test_xlDelimited(ByRef num)
-Range("A627").Clear
-Range("B627").Clear
-Range("C627").Clear
-Range("D627").Clear
-Range("A627").Value = "xlDelimited"
-Range("B627").Value = 1
-Range("C627").Value = num
-B627 = Range("B627").Value
-C627 = Range("C627").Value
-If B627 = C627 Then
-Range("D627").Value = "OK"
-Else
-Range("D627").Value = "NG"
-End If
-End Function
-
-Function test_xlFixedWidth(ByRef num)
-Range("A628").Clear
-Range("B628").Clear
-Range("C628").Clear
-Range("D628").Clear
-Range("A628").Value = "xlFixedWidth"
-Range("B628").Value = 2
-Range("C628").Value = num
-B628 = Range("B628").Value
-C628 = Range("C628").Value
-If B628 = C628 Then
-Range("D628").Value = "OK"
-Else
-Range("D628").Value = "NG"
-End If
-End Function
-
-Function test_xlTextQualifierDoubleQuote(ByRef num)
-Range("A629").Clear
-Range("B629").Clear
-Range("C629").Clear
-Range("D629").Clear
-Range("A629").Value = "xlTextQualifierDoubleQuote"
-Range("B629").Value = 1
-Range("C629").Value = num
-B629 = Range("B629").Value
-C629 = Range("C629").Value
-If B629 = C629 Then
-Range("D629").Value = "OK"
-Else
-Range("D629").Value = "NG"
-End If
-End Function
-
-Function test_xlTextQualifierNone(ByRef num)
-Range("A630").Clear
-Range("B630").Clear
-Range("C630").Clear
-Range("D630").Clear
-Range("A630").Value = "xlTextQualifierNone"
-Range("B630").Value = -4142
-Range("C630").Value = num
-B630 = Range("B630").Value
-C630 = Range("C630").Value
-If B630 = C630 Then
-Range("D630").Value = "OK"
-Else
-Range("D630").Value = "NG"
-End If
-End Function
-
-Function test_xlTextQualifierSingleQuote(ByRef num)
-Range("A631").Clear
-Range("B631").Clear
-Range("C631").Clear
-Range("D631").Clear
-Range("A631").Value = "xlTextQualifierSingleQuote"
-Range("B631").Value = 2
-Range("C631").Value = num
-B631 = Range("B631").Value
-C631 = Range("C631").Value
-If B631 = C631 Then
-Range("D631").Value = "OK"
-Else
-Range("D631").Value = "NG"
-End If
-End Function
-
-Function test_xlTextVisualLTR(ByRef num)
-Range("A632").Clear
-Range("B632").Clear
-Range("C632").Clear
-Range("D632").Clear
-Range("A632").Value = "xlTextVisualLTR"
-Range("B632").Value = 1
-Range("C632").Value = num
-B632 = Range("B632").Value
-C632 = Range("C632").Value
-If B632 = C632 Then
-Range("D632").Value = "OK"
-Else
-Range("D632").Value = "NG"
-End If
-End Function
-
-Function test_xlTextVisualRTL(ByRef num)
-Range("A633").Clear
-Range("B633").Clear
-Range("C633").Clear
-Range("D633").Clear
-Range("A633").Value = "xlTextVisualRTL"
-Range("B633").Value = 2
-Range("C633").Value = num
-B633 = Range("B633").Value
-C633 = Range("C633").Value
-If B633 = C633 Then
-Range("D633").Value = "OK"
-Else
-Range("D633").Value = "NG"
-End If
-End Function
-
-Function test_XlTickLabelOrientationAutomatic(ByRef num)
-Range("A634").Clear
-Range("B634").Clear
-Range("C634").Clear
-Range("D634").Clear
-Range("A634").Value = "XlTickLabelOrientationAutomatic"
-Range("B634").Value = -4105
-Range("C634").Value = num
-B634 = Range("B634").Value
-C634 = Range("C634").Value
-If B634 = C634 Then
-Range("D634").Value = "OK"
-Else
-Range("D634").Value = "NG"
-End If
-End Function
-
-Function test_XlTickLabelOrientationDownward(ByRef num)
-Range("A635").Clear
-Range("B635").Clear
-Range("C635").Clear
-Range("D635").Clear
-Range("A635").Value = "XlTickLabelOrientationDownward"
-Range("B635").Value = -4170
-Range("C635").Value = num
-B635 = Range("B635").Value
-C635 = Range("C635").Value
-If B635 = C635 Then
-Range("D635").Value = "OK"
-Else
-Range("D635").Value = "NG"
-End If
-End Function
-
-Function test_XlTickLabelOrientationHorizontal(ByRef num)
-Range("A636").Clear
-Range("B636").Clear
-Range("C636").Clear
-Range("D636").Clear
-Range("A636").Value = "XlTickLabelOrientationHorizontal"
-Range("B636").Value = -4128
-Range("C636").Value = num
-B636 = Range("B636").Value
-C636 = Range("C636").Value
-If B636 = C636 Then
-Range("D636").Value = "OK"
-Else
-Range("D636").Value = "NG"
-End If
-End Function
-
-Function test_XlTickLabelOrientationUpward(ByRef num)
-Range("A637").Clear
-Range("B637").Clear
-Range("C637").Clear
-Range("D637").Clear
-Range("A637").Value = "XlTickLabelOrientationUpward"
-Range("B637").Value = -4171
-Range("C637").Value = num
-B637 = Range("B637").Value
-C637 = Range("C637").Value
-If B637 = C637 Then
-Range("D637").Value = "OK"
-Else
-Range("D637").Value = "NG"
-End If
-End Function
-
-Function test_XlTickLabelOrientationVertical(ByRef num)
-Range("A638").Clear
-Range("B638").Clear
-Range("C638").Clear
-Range("D638").Clear
-Range("A638").Value = "XlTickLabelOrientationVertical"
-Range("B638").Value = -4166
-Range("C638").Value = num
-B638 = Range("B638").Value
-C638 = Range("C638").Value
-If B638 = C638 Then
-Range("D638").Value = "OK"
-Else
-Range("D638").Value = "NG"
-End If
-End Function
-
-Function test_xlTickLabelPositionHigh(ByRef num)
-Range("A639").Clear
-Range("B639").Clear
-Range("C639").Clear
-Range("D639").Clear
-Range("A639").Value = "xlTickLabelPositionHigh"
-Range("B639").Value = -4127
-Range("C639").Value = num
-B639 = Range("B639").Value
-C639 = Range("C639").Value
-If B639 = C639 Then
-Range("D639").Value = "OK"
-Else
-Range("D639").Value = "NG"
-End If
-End Function
-
-Function test_xlTickLabelPositionLow(ByRef num)
-Range("A640").Clear
-Range("B640").Clear
-Range("C640").Clear
-Range("D640").Clear
-Range("A640").Value = "xlTickLabelPositionLow"
-Range("B640").Value = -4134
-Range("C640").Value = num
-B640 = Range("B640").Value
-C640 = Range("C640").Value
-If B640 = C640 Then
-Range("D640").Value = "OK"
-Else
-Range("D640").Value = "NG"
-End If
-End Function
-
-Function test_xlTickLabelPositionNextToAxis(ByRef num)
-Range("A641").Clear
-Range("B641").Clear
-Range("C641").Clear
-Range("D641").Clear
-Range("A641").Value = "xlTickLabelPositionNextToAxis"
-Range("B641").Value = 4
-Range("C641").Value = num
-B641 = Range("B641").Value
-C641 = Range("C641").Value
-If B641 = C641 Then
-Range("D641").Value = "OK"
-Else
-Range("D641").Value = "NG"
-End If
-End Function
-
-Function test_xlTickLabelPositionNone(ByRef num)
-Range("A642").Clear
-Range("B642").Clear
-Range("C642").Clear
-Range("D642").Clear
-Range("A642").Value = "xlTickLabelPositionNone"
-Range("B642").Value = -4142
-Range("C642").Value = num
-B642 = Range("B642").Value
-C642 = Range("C642").Value
-If B642 = C642 Then
-Range("D642").Value = "OK"
-Else
-Range("D642").Value = "NG"
-End If
-End Function
-
-Function test_xlTickMarkCross(ByRef num)
-Range("A643").Clear
-Range("B643").Clear
-Range("C643").Clear
-Range("D643").Clear
-Range("A643").Value = "xlTickMarkCross"
-Range("B643").Value = 4
-Range("C643").Value = num
-B643 = Range("B643").Value
-C643 = Range("C643").Value
-If B643 = C643 Then
-Range("D643").Value = "OK"
-Else
-Range("D643").Value = "NG"
-End If
-End Function
-
-Function test_xlTickMarkInside(ByRef num)
-Range("A644").Clear
-Range("B644").Clear
-Range("C644").Clear
-Range("D644").Clear
-Range("A644").Value = "xlTickMarkInside"
-Range("B644").Value = 2
-Range("C644").Value = num
-B644 = Range("B644").Value
-C644 = Range("C644").Value
-If B644 = C644 Then
-Range("D644").Value = "OK"
-Else
-Range("D644").Value = "NG"
-End If
-End Function
-
-Function test_xlTickMarkNone(ByRef num)
-Range("A645").Clear
-Range("B645").Clear
-Range("C645").Clear
-Range("D645").Clear
-Range("A645").Value = "xlTickMarkNone"
-Range("B645").Value = -4142
-Range("C645").Value = num
-B645 = Range("B645").Value
-C645 = Range("C645").Value
-If B645 = C645 Then
-Range("D645").Value = "OK"
-Else
-Range("D645").Value = "NG"
-End If
-End Function
-
-Function test_xlTickMarkOutside(ByRef num)
-Range("A646").Clear
-Range("B646").Clear
-Range("C646").Clear
-Range("D646").Clear
-Range("A646").Value = "xlTickMarkOutside"
-Range("B646").Value = 3
-Range("C646").Value = num
-B646 = Range("B646").Value
-C646 = Range("C646").Value
-If B646 = C646 Then
-Range("D646").Value = "OK"
-Else
-Range("D646").Value = "NG"
-End If
-End Function
-
-Function test_xlDays(ByRef num)
-Range("A647").Clear
-Range("B647").Clear
-Range("C647").Clear
-Range("D647").Clear
-Range("A647").Value = "xlDays"
-Range("B647").Value = 0
-Range("C647").Value = num
-B647 = Range("B647").Value
-C647 = Range("C647").Value
-If B647 = C647 Then
-Range("D647").Value = "OK"
-Else
-Range("D647").Value = "NG"
-End If
-End Function
-
-Function test_xlMonths(ByRef num)
-Range("A648").Clear
-Range("B648").Clear
-Range("C648").Clear
-Range("D648").Clear
-Range("A648").Value = "xlMonths"
-Range("B648").Value = 1
-Range("C648").Value = num
-B648 = Range("B648").Value
-C648 = Range("C648").Value
-If B648 = C648 Then
-Range("D648").Value = "OK"
-Else
-Range("D648").Value = "NG"
-End If
-End Function
-
-Function test_xlYears(ByRef num)
-Range("A649").Clear
-Range("B649").Clear
-Range("C649").Clear
-Range("D649").Clear
-Range("A649").Value = "xlYears"
-Range("B649").Value = 2
-Range("C649").Value = num
-B649 = Range("B649").Value
-C649 = Range("C649").Value
-If B649 = C649 Then
-Range("D649").Value = "OK"
-Else
-Range("D649").Value = "NG"
-End If
-End Function
-
-Function test_xlNoButtonChanges(ByRef num)
-Range("A650").Clear
-Range("B650").Clear
-Range("C650").Clear
-Range("D650").Clear
-Range("A650").Value = "xlNoButtonChanges"
-Range("B650").Value = 1
-Range("C650").Value = num
-B650 = Range("B650").Value
-C650 = Range("C650").Value
-If B650 = C650 Then
-Range("D650").Value = "OK"
-Else
-Range("D650").Value = "NG"
-End If
-End Function
-
-Function test_xlNoChanges(ByRef num)
-Range("A651").Clear
-Range("B651").Clear
-Range("C651").Clear
-Range("D651").Clear
-Range("A651").Value = "xlNoChanges"
-Range("B651").Value = 4
-Range("C651").Value = num
-B651 = Range("B651").Value
-C651 = Range("C651").Value
-If B651 = C651 Then
-Range("D651").Value = "OK"
-Else
-Range("D651").Value = "NG"
-End If
-End Function
-
-Function test_xlNoDockingChanges(ByRef num)
-Range("A652").Clear
-Range("B652").Clear
-Range("C652").Clear
-Range("D652").Clear
-Range("A652").Value = "xlNoDockingChanges"
-Range("B652").Value = 3
-Range("C652").Value = num
-B652 = Range("B652").Value
-C652 = Range("C652").Value
-If B652 = C652 Then
-Range("D652").Value = "OK"
-Else
-Range("D652").Value = "NG"
-End If
-End Function
-
-Function test_xlNoShapeChanges(ByRef num)
-Range("A653").Clear
-Range("B653").Clear
-Range("C653").Clear
-Range("D653").Clear
-Range("A653").Value = "xlNoShapeChanges"
-Range("B653").Value = 2
-Range("C653").Value = num
-B653 = Range("B653").Value
-C653 = Range("C653").Value
-If B653 = C653 Then
-Range("D653").Value = "OK"
-Else
-Range("D653").Value = "NG"
-End If
-End Function
-
-Function test_xlToolbarProtectionNone(ByRef num)
-Range("A654").Clear
-Range("B654").Clear
-Range("C654").Clear
-Range("D654").Clear
-Range("A654").Value = "xlToolbarProtectionNone"
-Range("B654").Value = -4143
-Range("C654").Value = num
-B654 = Range("B654").Value
-C654 = Range("C654").Value
-If B654 = C654 Then
-Range("D654").Value = "OK"
-Else
-Range("D654").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationAverage(ByRef num)
-Range("A655").Clear
-Range("B655").Clear
-Range("C655").Clear
-Range("D655").Clear
-Range("A655").Value = "xlTotalsCalculationAverage"
-Range("B655").Value = 2
-Range("C655").Value = num
-B655 = Range("B655").Value
-C655 = Range("C655").Value
-If B655 = C655 Then
-Range("D655").Value = "OK"
-Else
-Range("D655").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCount(ByRef num)
-Range("A656").Clear
-Range("B656").Clear
-Range("C656").Clear
-Range("D656").Clear
-Range("A656").Value = "xlTotalsCalculationCount"
-Range("B656").Value = 3
-Range("C656").Value = num
-B656 = Range("B656").Value
-C656 = Range("C656").Value
-If B656 = C656 Then
-Range("D656").Value = "OK"
-Else
-Range("D656").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountNums(ByRef num)
-Range("A657").Clear
-Range("B657").Clear
-Range("C657").Clear
-Range("D657").Clear
-Range("A657").Value = "xlTotalsCalculationCountNums"
-Range("B657").Value = 4
-Range("C657").Value = num
-B657 = Range("B657").Value
-C657 = Range("C657").Value
-If B657 = C657 Then
-Range("D657").Value = "OK"
-Else
-Range("D657").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountMax(ByRef num)
-Range("A658").Clear
-Range("B658").Clear
-Range("C658").Clear
-Range("D658").Clear
-Range("A658").Value = "xlTotalsCalculationCountMax"
-Range("B658").Value = 6
-Range("C658").Value = num
-B658 = Range("B658").Value
-C658 = Range("C658").Value
-If B658 = C658 Then
-Range("D658").Value = "OK"
-Else
-Range("D658").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountMin(ByRef num)
-Range("A659").Clear
-Range("B659").Clear
-Range("C659").Clear
-Range("D659").Clear
-Range("A659").Value = "xlTotalsCalculationCountMin"
-Range("B659").Value = 5
-Range("C659").Value = num
-B659 = Range("B659").Value
-C659 = Range("C659").Value
-If B659 = C659 Then
-Range("D659").Value = "OK"
-Else
-Range("D659").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountNone(ByRef num)
-Range("A660").Clear
-Range("B660").Clear
-Range("C660").Clear
-Range("D660").Clear
-Range("A660").Value = "xlTotalsCalculationCountNone"
-Range("B660").Value = 0
-Range("C660").Value = num
-B660 = Range("B660").Value
-C660 = Range("C660").Value
-If B660 = C660 Then
-Range("D660").Value = "OK"
-Else
-Range("D660").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountStdDev(ByRef num)
-Range("A661").Clear
-Range("B661").Clear
-Range("C661").Clear
-Range("D661").Clear
-Range("A661").Value = "xlTotalsCalculationCountStdDev"
-Range("B661").Value = 7
-Range("C661").Value = num
-B661 = Range("B661").Value
-C661 = Range("C661").Value
-If B661 = C661 Then
-Range("D661").Value = "OK"
-Else
-Range("D661").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountSum(ByRef num)
-Range("A662").Clear
-Range("B662").Clear
-Range("C662").Clear
-Range("D662").Clear
-Range("A662").Value = "xlTotalsCalculationCountSum"
-Range("B662").Value = 1
-Range("C662").Value = num
-B662 = Range("B662").Value
-C662 = Range("C662").Value
-If B662 = C662 Then
-Range("D662").Value = "OK"
-Else
-Range("D662").Value = "NG"
-End If
-End Function
-
-Function test_xlTotalsCalculationCountVar(ByRef num)
-Range("A663").Clear
-Range("B663").Clear
-Range("C663").Clear
-Range("D663").Clear
-Range("A663").Value = "xlTotalsCalculationCountVar"
-Range("B663").Value = 8
-Range("C663").Value = num
-B663 = Range("B663").Value
-C663 = Range("C663").Value
-If B663 = C663 Then
-Range("D663").Value = "OK"
-Else
-Range("D663").Value = "NG"
-End If
-End Function
-
-Function test_xlExponential(ByRef num)
-Range("A664").Clear
-Range("B664").Clear
-Range("C664").Clear
-Range("D664").Clear
-Range("A664").Value = "xlExponential"
-Range("B664").Value = 5
-Range("C664").Value = num
-B664 = Range("B664").Value
-C664 = Range("C664").Value
-If B664 = C664 Then
-Range("D664").Value = "OK"
-Else
-Range("D664").Value = "NG"
-End If
-End Function
-
-Function test_xlLinear(ByRef num)
-Range("A665").Clear
-Range("B665").Clear
-Range("C665").Clear
-Range("D665").Clear
-Range("A665").Value = "xlLinear"
-Range("B665").Value = -4132
-Range("C665").Value = num
-B665 = Range("B665").Value
-C665 = Range("C665").Value
-If B665 = C665 Then
-Range("D665").Value = "OK"
-Else
-Range("D665").Value = "NG"
-End If
-End Function
-
-Function test_xlLogarithmic(ByRef num)
-Range("A666").Clear
-Range("B666").Clear
-Range("C666").Clear
-Range("D666").Clear
-Range("A666").Value = "xlLogarithmic"
-Range("B666").Value = -4133
-Range("C666").Value = num
-B666 = Range("B666").Value
-C666 = Range("C666").Value
-If B666 = C666 Then
-Range("D666").Value = "OK"
-Else
-Range("D666").Value = "NG"
-End If
-End Function
-
-Function test_xlMovingAvg(ByRef num)
-Range("A667").Clear
-Range("B667").Clear
-Range("C667").Clear
-Range("D667").Clear
-Range("A667").Value = "xlMovingAvg"
-Range("B667").Value = 6
-Range("C667").Value = num
-B667 = Range("B667").Value
-C667 = Range("C667").Value
-If B667 = C667 Then
-Range("D667").Value = "OK"
-Else
-Range("D667").Value = "NG"
-End If
-End Function
-
-Function test_xlPolynomial(ByRef num)
-Range("A668").Clear
-Range("B668").Clear
-Range("C668").Clear
-Range("D668").Clear
-Range("A668").Value = "xlPolynomial"
-Range("B668").Value = 3
-Range("C668").Value = num
-B668 = Range("B668").Value
-C668 = Range("C668").Value
-If B668 = C668 Then
-Range("D668").Value = "OK"
-Else
-Range("D668").Value = "NG"
-End If
-End Function
-
-Function test_xlPower(ByRef num)
-Range("A669").Clear
-Range("B669").Clear
-Range("C669").Clear
-Range("D669").Clear
-Range("A669").Value = "xlPower"
-Range("B669").Value = 4
-Range("C669").Value = num
-B669 = Range("B669").Value
-C669 = Range("C669").Value
-If B669 = C669 Then
-Range("D669").Value = "OK"
-Else
-Range("D669").Value = "NG"
-End If
-End Function
-
-Function test_XlUnderlineStyleDouble(ByRef num)
-Range("A670").Clear
-Range("B670").Clear
-Range("C670").Clear
-Range("D670").Clear
-Range("A670").Value = "XlUnderlineStyleDouble"
-Range("B670").Value = -4119
-Range("C670").Value = num
-B670 = Range("B670").Value
-C670 = Range("C670").Value
-If B670 = C670 Then
-Range("D670").Value = "OK"
-Else
-Range("D670").Value = "NG"
-End If
-End Function
-
-Function test_XlUnderlineStyleDoubleAccounting(ByRef num)
-Range("A671").Clear
-Range("B671").Clear
-Range("C671").Clear
-Range("D671").Clear
-Range("A671").Value = "XlUnderlineStyleDoubleAccounting"
-Range("B671").Value = 5
-Range("C671").Value = num
-B671 = Range("B671").Value
-C671 = Range("C671").Value
-If B671 = C671 Then
-Range("D671").Value = "OK"
-Else
-Range("D671").Value = "NG"
-End If
-End Function
-
-Function test_XlUnderlineStyleNone(ByRef num)
-Range("A672").Clear
-Range("B672").Clear
-Range("C672").Clear
-Range("D672").Clear
-Range("A672").Value = "XlUnderlineStyleNone"
-Range("B672").Value = -4142
-Range("C672").Value = num
-B672 = Range("B672").Value
-C672 = Range("C672").Value
-If B672 = C672 Then
-Range("D672").Value = "OK"
-Else
-Range("D672").Value = "NG"
-End If
-End Function
-
-Function test_XlUnderlineStyleSingle(ByRef num)
-Range("A673").Clear
-Range("B673").Clear
-Range("C673").Clear
-Range("D673").Clear
-Range("A673").Value = "XlUnderlineStyleSingle"
-Range("B673").Value = 2
-Range("C673").Value = num
-B673 = Range("B673").Value
-C673 = Range("C673").Value
-If B673 = C673 Then
-Range("D673").Value = "OK"
-Else
-Range("D673").Value = "NG"
-End If
-End Function
-
-Function test_XlUnderlineStyleSingleAccounting(ByRef num)
-Range("A674").Clear
-Range("B674").Clear
-Range("C674").Clear
-Range("D674").Clear
-Range("A674").Value = "XlUnderlineStyleSingleAccounting"
-Range("B674").Value = 4
-Range("C674").Value = num
-B674 = Range("B674").Value
-C674 = Range("C674").Value
-If B674 = C674 Then
-Range("D674").Value = "OK"
-Else
-Range("D674").Value = "NG"
-End If
-End Function
-
-Function test_XlUpdateLinksAlways(ByRef num)
-Range("A675").Clear
-Range("B675").Clear
-Range("C675").Clear
-Range("D675").Clear
-Range("A675").Value = "XlUpdateLinksAlways"
-Range("B675").Value = 3
-Range("C675").Value = num
-B675 = Range("B675").Value
-C675 = Range("C675").Value
-If B675 = C675 Then
-Range("D675").Value = "OK"
-Else
-Range("D675").Value = "NG"
-End If
-End Function
-
-Function test_XlUpdateLinksNever(ByRef num)
-Range("A676").Clear
-Range("B676").Clear
-Range("C676").Clear
-Range("D676").Clear
-Range("A676").Value = "XlUpdateLinksNever"
-Range("B676").Value = 2
-Range("C676").Value = num
-B676 = Range("B676").Value
-C676 = Range("C676").Value
-If B676 = C676 Then
-Range("D676").Value = "OK"
-Else
-Range("D676").Value = "NG"
-End If
-End Function
-
-Function test_XlUpdateLinksUserSetting(ByRef num)
-Range("A677").Clear
-Range("B677").Clear
-Range("C677").Clear
-Range("D677").Clear
-Range("A677").Value = "XlUpdateLinksUserSetting"
-Range("B677").Value = 1
-Range("C677").Value = num
-B677 = Range("B677").Value
-C677 = Range("C677").Value
-If B677 = C677 Then
-Range("D677").Value = "OK"
-Else
-Range("D677").Value = "NG"
-End If
-End Function
-
-Function test_xlVAlignBottom(ByRef num)
-Range("A678").Clear
-Range("B678").Clear
-Range("C678").Clear
-Range("D678").Clear
-Range("A678").Value = "xlVAlignBottom"
-Range("B678").Value = -4107
-Range("C678").Value = num
-B678 = Range("B678").Value
-C678 = Range("C678").Value
-If B678 = C678 Then
-Range("D678").Value = "OK"
-Else
-Range("D678").Value = "NG"
-End If
-End Function
-
-Function test_xlVAlignCenter(ByRef num)
-Range("A679").Clear
-Range("B679").Clear
-Range("C679").Clear
-Range("D679").Clear
-Range("A679").Value = "xlVAlignCenter"
-Range("B679").Value = -4108
-Range("C679").Value = num
-B679 = Range("B679").Value
-C679 = Range("C679").Value
-If B679 = C679 Then
-Range("D679").Value = "OK"
-Else
-Range("D679").Value = "NG"
-End If
-End Function
-
-Function test_xlVAlignDistributed(ByRef num)
-Range("A680").Clear
-Range("B680").Clear
-Range("C680").Clear
-Range("D680").Clear
-Range("A680").Value = "xlVAlignDistributed"
-Range("B680").Value = -4117
-Range("C680").Value = num
-B680 = Range("B680").Value
-C680 = Range("C680").Value
-If B680 = C680 Then
-Range("D680").Value = "OK"
-Else
-Range("D680").Value = "NG"
-End If
-End Function
-
-Function test_xlVAlignJustify(ByRef num)
-Range("A681").Clear
-Range("B681").Clear
-Range("C681").Clear
-Range("D681").Clear
-Range("A681").Value = "xlVAlignJustify"
-Range("B681").Value = -4130
-Range("C681").Value = num
-B681 = Range("B681").Value
-C681 = Range("C681").Value
-If B681 = C681 Then
-Range("D681").Value = "OK"
-Else
-Range("D681").Value = "NG"
-End If
-End Function
-
-Function test_xlVAlignTop(ByRef num)
-Range("A682").Clear
-Range("B682").Clear
-Range("C682").Clear
-Range("D682").Clear
-Range("A682").Value = "xlVAlignTop"
-Range("B682").Value = -4160
-Range("C682").Value = num
-B682 = Range("B682").Value
-C682 = Range("C682").Value
-If B682 = C682 Then
-Range("D682").Value = "OK"
-Else
-Range("D682").Value = "NG"
-End If
-End Function
-
-Function test_XlWBATChart(ByRef num)
-Range("A683").Clear
-Range("B683").Clear
-Range("C683").Clear
-Range("D683").Clear
-Range("A683").Value = "XlWBATChart"
-Range("B683").Value = -4109
-Range("C683").Value = num
-B683 = Range("B683").Value
-C683 = Range("C683").Value
-If B683 = C683 Then
-Range("D683").Value = "OK"
-Else
-Range("D683").Value = "NG"
-End If
-End Function
-
-Function test_XlWBATExcel4IntlMacroSheet(ByRef num)
-Range("A684").Clear
-Range("B684").Clear
-Range("C684").Clear
-Range("D684").Clear
-Range("A684").Value = "XlWBATExcel4IntlMacroSheet"
-Range("B684").Value = 4
-Range("C684").Value = num
-B684 = Range("B684").Value
-C684 = Range("C684").Value
-If B684 = C684 Then
-Range("D684").Value = "OK"
-Else
-Range("D684").Value = "NG"
-End If
-End Function
-
-Function test_XlWBATExcel4MacroSheet(ByRef num)
-Range("A685").Clear
-Range("B685").Clear
-Range("C685").Clear
-Range("D685").Clear
-Range("A685").Value = "XlWBATExcel4MacroSheet"
-Range("B685").Value = 3
-Range("C685").Value = num
-B685 = Range("B685").Value
-C685 = Range("C685").Value
-If B685 = C685 Then
-Range("D685").Value = "OK"
-Else
-Range("D685").Value = "NG"
-End If
-End Function
-
-Function test_XlWBATWorksheet(ByRef num)
-Range("A686").Clear
-Range("B686").Clear
-Range("C686").Clear
-Range("D686").Clear
-Range("A686").Value = "XlWBATWorksheet"
-Range("B686").Value = -4167
-Range("C686").Value = num
-B686 = Range("B686").Value
-C686 = Range("C686").Value
-If B686 = C686 Then
-Range("D686").Value = "OK"
-Else
-Range("D686").Value = "NG"
-End If
-End Function
-
-Function test_xlWebFormattingAll(ByRef num)
-Range("A687").Clear
-Range("B687").Clear
-Range("C687").Clear
-Range("D687").Clear
-Range("A687").Value = "xlWebFormattingAll"
-Range("B687").Value = 1
-Range("C687").Value = num
-B687 = Range("B687").Value
-C687 = Range("C687").Value
-If B687 = C687 Then
-Range("D687").Value = "OK"
-Else
-Range("D687").Value = "NG"
-End If
-End Function
-
-Function test_xlWebFormattingNone(ByRef num)
-Range("A688").Clear
-Range("B688").Clear
-Range("C688").Clear
-Range("D688").Clear
-Range("A688").Value = "xlWebFormattingNone"
-Range("B688").Value = 3
-Range("C688").Value = num
-B688 = Range("B688").Value
-C688 = Range("C688").Value
-If B688 = C688 Then
-Range("D688").Value = "OK"
-Else
-Range("D688").Value = "NG"
-End If
-End Function
-
-Function test_xlWebFormattingRTF(ByRef num)
-Range("A689").Clear
-Range("B689").Clear
-Range("C689").Clear
-Range("D689").Clear
-Range("A689").Value = "xlWebFormattingRTF"
-Range("B689").Value = 2
-Range("C689").Value = num
-B689 = Range("B689").Value
-C689 = Range("C689").Value
-If B689 = C689 Then
-Range("D689").Value = "OK"
-Else
-Range("D689").Value = "NG"
-End If
-End Function
-
-Function test_xlAllTables(ByRef num)
-Range("A690").Clear
-Range("B690").Clear
-Range("C690").Clear
-Range("D690").Clear
-Range("A690").Value = "xlAllTables"
-Range("B690").Value = 2
-Range("C690").Value = num
-B690 = Range("B690").Value
-C690 = Range("C690").Value
-If B690 = C690 Then
-Range("D690").Value = "OK"
-Else
-Range("D690").Value = "NG"
-End If
-End Function
-
-Function test_xlEntirePage(ByRef num)
-Range("A691").Clear
-Range("B691").Clear
-Range("C691").Clear
-Range("D691").Clear
-Range("A691").Value = "xlEntirePage"
-Range("B691").Value = 1
-Range("C691").Value = num
-B691 = Range("B691").Value
-C691 = Range("C691").Value
-If B691 = C691 Then
-Range("D691").Value = "OK"
-Else
-Range("D691").Value = "NG"
-End If
-End Function
-
-Function test_xlSpecifiedTables(ByRef num)
-Range("A692").Clear
-Range("B692").Clear
-Range("C692").Clear
-Range("D692").Clear
-Range("A692").Value = "xlSpecifiedTables"
-Range("B692").Value = 3
-Range("C692").Value = num
-B692 = Range("B692").Value
-C692 = Range("C692").Value
-If B692 = C692 Then
-Range("D692").Value = "OK"
-Else
-Range("D692").Value = "NG"
-End If
-End Function
-
-Function test_xlMaximized(ByRef num)
-Range("A693").Clear
-Range("B693").Clear
-Range("C693").Clear
-Range("D693").Clear
-Range("A693").Value = "xlMaximized"
-Range("B693").Value = -4137
-Range("C693").Value = num
-B693 = Range("B693").Value
-C693 = Range("C693").Value
-If B693 = C693 Then
-Range("D693").Value = "OK"
-Else
-Range("D693").Value = "NG"
-End If
-End Function
-
-Function test_xlMinimized(ByRef num)
-Range("A694").Clear
-Range("B694").Clear
-Range("C694").Clear
-Range("D694").Clear
-Range("A694").Value = "xlMinimized"
-Range("B694").Value = -4140
-Range("C694").Value = num
-B694 = Range("B694").Value
-C694 = Range("C694").Value
-If B694 = C694 Then
-Range("D694").Value = "OK"
-Else
-Range("D694").Value = "NG"
-End If
-End Function
-
-Function test_xlNormal(ByRef num)
-Range("A695").Clear
-Range("B695").Clear
-Range("C695").Clear
-Range("D695").Clear
-Range("A695").Value = "xlNormal"
-Range("B695").Value = -4143
-Range("C695").Value = num
-B695 = Range("B695").Value
-C695 = Range("C695").Value
-If B695 = C695 Then
-Range("D695").Value = "OK"
-Else
-Range("D695").Value = "NG"
-End If
-End Function
-
-Function test_xlChartAsWindow(ByRef num)
-Range("A696").Clear
-Range("B696").Clear
-Range("C696").Clear
-Range("D696").Clear
-Range("A696").Value = "xlChartAsWindow"
-Range("B696").Value = 5
-Range("C696").Value = num
-B696 = Range("B696").Value
-C696 = Range("C696").Value
-If B696 = C696 Then
-Range("D696").Value = "OK"
-Else
-Range("D696").Value = "NG"
-End If
-End Function
-
-Function test_xlChartInPlace(ByRef num)
-Range("A697").Clear
-Range("B697").Clear
-Range("C697").Clear
-Range("D697").Clear
-Range("A697").Value = "xlChartInPlace"
-Range("B697").Value = 4
-Range("C697").Value = num
-B697 = Range("B697").Value
-C697 = Range("C697").Value
-If B697 = C697 Then
-Range("D697").Value = "OK"
-Else
-Range("D697").Value = "NG"
-End If
-End Function
-
-Function test_xlClipboard(ByRef num)
-Range("A698").Clear
-Range("B698").Clear
-Range("C698").Clear
-Range("D698").Clear
-Range("A698").Value = "xlClipboard"
-Range("B698").Value = 3
-Range("C698").Value = num
-B698 = Range("B698").Value
-C698 = Range("C698").Value
-If B698 = C698 Then
-Range("D698").Value = "OK"
-Else
-Range("D698").Value = "NG"
-End If
-End Function
-
-Function test_xlInfo(ByRef num)
-Range("A699").Clear
-Range("B699").Clear
-Range("C699").Clear
-Range("D699").Clear
-Range("A699").Value = "xlInfo"
-Range("B699").Value = -4129
-Range("C699").Value = num
-B699 = Range("B699").Value
-C699 = Range("C699").Value
-If B699 = C699 Then
-Range("D699").Value = "OK"
-Else
-Range("D699").Value = "NG"
-End If
-End Function
-
-Function test_xlWordbook(ByRef num)
-Range("A700").Clear
-Range("B700").Clear
-Range("C700").Clear
-Range("D700").Clear
-Range("A700").Value = "xlWordbook"
-Range("B700").Value = 1
-Range("C700").Value = num
-B700 = Range("B700").Value
-C700 = Range("C700").Value
-If B700 = C700 Then
-Range("D700").Value = "OK"
-Else
-Range("D700").Value = "NG"
-End If
-End Function
-
-Function test_xlNormalView(ByRef num)
-Range("A701").Clear
-Range("B701").Clear
-Range("C701").Clear
-Range("D701").Clear
-Range("A701").Value = "xlNormalView"
-Range("B701").Value = 1
-Range("C701").Value = num
-B701 = Range("B701").Value
-C701 = Range("C701").Value
-If B701 = C701 Then
-Range("D701").Value = "OK"
-Else
-Range("D701").Value = "NG"
-End If
-End Function
-
-Function test_xlPageBreakPreview(ByRef num)
-Range("A702").Clear
-Range("B702").Clear
-Range("C702").Clear
-Range("D702").Clear
-Range("A702").Value = "xlPageBreakPreview"
-Range("B702").Value = 2
-Range("C702").Value = num
-B702 = Range("B702").Value
-C702 = Range("C702").Value
-If B702 = C702 Then
-Range("D702").Value = "OK"
-Else
-Range("D702").Value = "NG"
-End If
-End Function
-
-Function test_xlCommand(ByRef num)
-Range("A703").Clear
-Range("B703").Clear
-Range("C703").Clear
-Range("D703").Clear
-Range("A703").Value = "xlCommand"
-Range("B703").Value = 2
-Range("C703").Value = num
-B703 = Range("B703").Value
-C703 = Range("C703").Value
-If B703 = C703 Then
-Range("D703").Value = "OK"
-Else
-Range("D703").Value = "NG"
-End If
-End Function
-
-Function test_xlFunction(ByRef num)
-Range("A704").Clear
-Range("B704").Clear
-Range("C704").Clear
-Range("D704").Clear
-Range("A704").Value = "xlFunction"
-Range("B704").Value = 1
-Range("C704").Value = num
-B704 = Range("B704").Value
-C704 = Range("C704").Value
-If B704 = C704 Then
-Range("D704").Value = "OK"
-Else
-Range("D704").Value = "NG"
-End If
-End Function
-
-Function test_xlnotXLM(ByRef num)
-Range("A705").Clear
-Range("B705").Clear
-Range("C705").Clear
-Range("D705").Clear
-Range("A705").Value = "xlnotXLM"
-Range("B705").Value = 3
-Range("C705").Value = num
-B705 = Range("B705").Value
-C705 = Range("C705").Value
-If B705 = C705 Then
-Range("D705").Value = "OK"
-Else
-Range("D705").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlExportSuccess(ByRef num)
-Range("A706").Clear
-Range("B706").Clear
-Range("C706").Clear
-Range("D706").Clear
-Range("A706").Value = "xlXmlExportSuccess"
-Range("B706").Value = 0
-Range("C706").Value = num
-B706 = Range("B706").Value
-C706 = Range("C706").Value
-If B706 = C706 Then
-Range("D706").Value = "OK"
-Else
-Range("D706").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlExportValidationFailed(ByRef num)
-Range("A707").Clear
-Range("B707").Clear
-Range("C707").Clear
-Range("D707").Clear
-Range("A707").Value = "xlXmlExportValidationFailed"
-Range("B707").Value = 1
-Range("C707").Value = num
-B707 = Range("B707").Value
-C707 = Range("C707").Value
-If B707 = C707 Then
-Range("D707").Value = "OK"
-Else
-Range("D707").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlImportElementsTruncated(ByRef num)
-Range("A708").Clear
-Range("B708").Clear
-Range("C708").Clear
-Range("D708").Clear
-Range("A708").Value = "xlXmlImportElementsTruncated"
-Range("B708").Value = 1
-Range("C708").Value = num
-B708 = Range("B708").Value
-C708 = Range("C708").Value
-If B708 = C708 Then
-Range("D708").Value = "OK"
-Else
-Range("D708").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlImportSuccess(ByRef num)
-Range("A709").Clear
-Range("B709").Clear
-Range("C709").Clear
-Range("D709").Clear
-Range("A709").Value = "xlXmlImportSuccess"
-Range("B709").Value = 0
-Range("C709").Value = num
-B709 = Range("B709").Value
-C709 = Range("C709").Value
-If B709 = C709 Then
-Range("D709").Value = "OK"
-Else
-Range("D709").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlImportValidationFailed(ByRef num)
-Range("A710").Clear
-Range("B710").Clear
-Range("C710").Clear
-Range("D710").Clear
-Range("A710").Value = "xlXmlImportValidationFailed"
-Range("B710").Value = 2
-Range("C710").Value = num
-B710 = Range("B710").Value
-C710 = Range("C710").Value
-If B710 = C710 Then
-Range("D710").Value = "OK"
-Else
-Range("D710").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlLoadImportToList(ByRef num)
-Range("A711").Clear
-Range("B711").Clear
-Range("C711").Clear
-Range("D711").Clear
-Range("A711").Value = "xlXmlLoadImportToList"
-Range("B711").Value = 2
-Range("C711").Value = num
-B711 = Range("B711").Value
-C711 = Range("C711").Value
-If B711 = C711 Then
-Range("D711").Value = "OK"
-Else
-Range("D711").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlLoadMapXml(ByRef num)
-Range("A712").Clear
-Range("B712").Clear
-Range("C712").Clear
-Range("D712").Clear
-Range("A712").Value = "xlXmlLoadMapXml"
-Range("B712").Value = 3
-Range("C712").Value = num
-B712 = Range("B712").Value
-C712 = Range("C712").Value
-If B712 = C712 Then
-Range("D712").Value = "OK"
-Else
-Range("D712").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlLoadOpenXml(ByRef num)
-Range("A713").Clear
-Range("B713").Clear
-Range("C713").Clear
-Range("D713").Clear
-Range("A713").Value = "xlXmlLoadOpenXml"
-Range("B713").Value = 1
-Range("C713").Value = num
-B713 = Range("B713").Value
-C713 = Range("C713").Value
-If B713 = C713 Then
-Range("D713").Value = "OK"
-Else
-Range("D713").Value = "NG"
-End If
-End Function
-
-Function test_xlXmlLoadPromptUser(ByRef num)
-Range("A714").Clear
-Range("B714").Clear
-Range("C714").Clear
-Range("D714").Clear
-Range("A714").Value = "xlXmlLoadPromptUser"
-Range("B714").Value = 0
-Range("C714").Value = num
-B714 = Range("B714").Value
-C714 = Range("C714").Value
-If B714 = C714 Then
-Range("D714").Value = "OK"
-Else
-Range("D714").Value = "NG"
-End If
-End Function
-
-Function test_xlGuess(ByRef num)
-Range("A715").Clear
-Range("B715").Clear
-Range("C715").Clear
-Range("D715").Clear
-Range("A715").Value = "xlGuess"
-Range("B715").Value = 0
-Range("C715").Value = num
-B715 = Range("B715").Value
-C715 = Range("C715").Value
-If B715 = C715 Then
-Range("D715").Value = "OK"
-Else
-Range("D715").Value = "NG"
-End If
-End Function
-
-Function test_xlNo(ByRef num)
-Range("A716").Clear
-Range("B716").Clear
-Range("C716").Clear
-Range("D716").Clear
-Range("A716").Value = "xlNo"
-Range("B716").Value = 2
-Range("C716").Value = num
-B716 = Range("B716").Value
-C716 = Range("C716").Value
-If B716 = C716 Then
-Range("D716").Value = "OK"
-Else
-Range("D716").Value = "NG"
-End If
-End Function
-
-Function test_xlYes(ByRef num)
-Range("A717").Clear
-Range("B717").Clear
-Range("C717").Clear
-Range("D717").Clear
-Range("A717").Value = "xlYes"
-Range("B717").Value = 1
-Range("C717").Value = num
-B717 = Range("B717").Value
-C717 = Range("C717").Value
-If B717 = C717 Then
-Range("D717").Value = "OK"
-Else
-Range("D717").Value = "NG"
-End If
-End Function
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'ProjectFoo'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Simple
->>>>>>
-Attribute VB_Name = "Simple"
-Function SGetThree()
-SGetThree = 3
-End Function
-
-Function SLoop()
-Dim i As Integer
-Dim j As Integer
-j = 0
-For i = 0 To 10
-    j = j + 1
-Next i
-SLoop = j
-End Function
-
-Function SNoRetVal()
-End Function
-<<<<<<
-======================
-MoreComplex
->>>>>>
-Attribute VB_Name = "MoreComplex"
-Function MGetThree()
-MGetThree = 3
-If MGetThree = 2 Then
- MsgBox ("Hello World")
-End If
-End Function
-
-Function MLoop()
-Dim i As Integer
-Dim j As Integer
-j = 0
-For i = 0 To 10
-    j = j + 1
-Next i
-If j = 17 Then
-    MLoop = Application.Sum(Range("A1:A10"))
-End If
-MLoop = j
-End Function
-
-Function MNoRetVal()
-Dim i As Integer
-End Function
-<<<<<<
-======================
-Real
->>>>>>
-Attribute VB_Name = "Real"
-Function CtoF(Centigrade)
-  CtoF = Centigrade * 9 / 5 + 32
-End Function
-
-Function WsF(Angle)
-  WsF = WorksheetFunction.Sinh(Angle)
-End Function
-<<<<<<
-======================
-FuncVal
->>>>>>
-Attribute VB_Name = "FuncVal"
-Function MyString()
-MyString = "teststring"
-End Function
-
-Function MyDouble()
-MyDouble = 1 / 8
-End Function
-
-Function MyBoolean()
-MyBoolean = False
-End Function
-
-Function MyInt()
-MyInt = 7
-End Function
-
-Function TakeOneArg(arg1)
-TakeOneArg = arg1
-End Function
-
-Function TakeTwoArgs(arg1, arg2)
-TakeTwoArgs = arg2
-End Function
-
-Function TakeThreeArgs(arg1, arg2, arg3)
-TakeThreeArgs = arg3
-End Function
-
-Function ContainsComment()
-Rem This is a comment
-ContainsComment = 3
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If Range("CloseFlag") <> "Y" Then
-        Worksheets("Workbook Examples").Activate
-        Range("CloseFlag").Activate
-        MsgBox "CloseFlag Cell must be 'Y' to close workbook"
-        Cancel = True
-    End If
-End Sub
-
-Private Sub Workbook_Open()
-    Worksheets("Change History").Activate
-    Range("VersionStart").Select
-    Selection.End(xlDown).Select
-    Selection.Copy (Worksheets("Overview").Range("VersionNumber"))
-    Worksheets("Workbook Examples").Activate
-    Range("CloseFlag") = "N"
-    Worksheets("Overview").Activate
-    Range("A1").Activate
-
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3, 4, 2, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    Call ListAllWorksheets
-End Sub
-
-Private Sub CommandButton2_Click()
-    Call ClearWorksheetNames
-End Sub
-
-Private Sub CommandButton3_Click()
-    Call AddNewWorksheet
-End Sub
-
-Private Sub Worksheet_Activate()
-    MsgBox "This pop-up message is displayed whenever this worksheet is activated."
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3, 3, 2, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    Call SelectToFromCells
-End Sub
-
-Private Sub CommandButton2_Click()
-    Call RotateMatrix
-End Sub
-
-Private Sub CommandButton3_Click()
-    Call ElementOperations
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Not (Intersect(Target, Range("MyCell")) Is Nothing) Then
-        Select Case LCase(Target.Value)
-            Case "a", "e", "i", "o", "u"
-                Range("MsgCell").Value = "vowel"
-                
-            Case "b" To "d", "f" To "h", "j" To "n", "p" To "t", "v" To "z"
-                Range("MsgCell").Value = "consonant"
-            
-            Case 0 To 9
-                Range("MsgCell").Value = "number"
-                
-            Case Else
-                Range("MsgCell").Value = "unknown"
-        End Select
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-WorksheetsVBACode
->>>>>>
-Attribute VB_Name = "WorksheetsVBACode"
-Sub AddNewWorksheet()
-    Dim wksh As Worksheet
-    
-    Set wksh = Worksheets.Add
-    wksh.Name = "MyNewSheet"
-End Sub
-Sub ListAllWorksheets()
-    Dim wksh As Worksheet
-    Dim i As Integer
-    
-    With Range("WkShNames")
-        i = 1
-        For Each wksh In ActiveWorkbook.Worksheets
-            .Cells(i).Value = wksh.Name
-            i = i + 1
-        Next
-    End With
-
-End Sub
-
-Sub ClearWorksheetNames()
-    Dim YesNoResponse As Integer
-    
-    Range("WkShNameArea").Select
-    
-    YesNoResponse = MsgBox("Clear Worksheet Name Area?", vbYesNo)
-    
-    If YesNoResponse = vbYes Then
-        Range("WkShNameArea").ClearContents
-
-    End If
-    
-    Range("a1").Select
-End Sub
-<<<<<<
-======================
-CellVBACode
->>>>>>
-Attribute VB_Name = "CellVBACode"
-Sub SelectToFromCells()
-    Range("FromCell", "ToCell").Select
-End Sub
-
-Sub RotateMatrix()
-    Dim i As Integer, j As Integer
-    Dim Temp As Variant
-    
-    With Range("MyMatrix")
-        Temp = .Cells(2, 1)
-        .Cells(2, 1) = .Cells(2, 2)
-        .Cells(2, 2) = .Cells(1, 2)
-        .Cells(1, 2) = .Cells(1, 1)
-        .Cells(1, 1) = Temp
-    End With
-End Sub
-
-
-Sub ElementOperations()
-    Dim i As Integer
-    Dim NumberOfElements As Integer
-    Dim ElementProduct As Double
-    Dim ElementSum As Double
-    
-    With Range("MyVector")
-        NumberOfElements = .Rows.Count
-        ElementProduct = 1
-        ElementSum = 0
-        For i = 1 To NumberOfElements
-            ElementProduct = ElementProduct * .Cells(i)
-            ElementSum = ElementSum + .Cells(i)
-        Next i
-    End With
-
-    Range("ElementProduct").Value = ElementProduct
-    Range("ElementSum").Value = ElementSum
-End Sub
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton2, 2, 1, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton3, 3, 2, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton4, 5, 4, MSForms, CommandButton"
-Attribute VB_Control = "CommandButton5, 6, 5, MSForms, CommandButton"
-Private Sub CommandButton1_Click()
-    Call getApplProperties
-End Sub
-
-Private Sub CommandButton2_Click()
-    Call generateDataToSort
-End Sub
-
-Private Sub CommandButton3_Click()
-    Call SortWithScreenUpdating
-End Sub
-
-Private Sub CommandButton4_Click()
-    Call SortWithNoScreenUpdating
-End Sub
-
-Private Sub CommandButton5_Click()
-    Call generateDataToSort
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("ApplProperties").ClearContents
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
-End Sub
-<<<<<<
-======================
-ApplicationCode
->>>>>>
-Attribute VB_Name = "ApplicationCode"
-'''
-''' Contains various VBA coding examples on accessing the Application Object
-'''
-Option Explicit
-
-
-Sub getApplProperties()
-    Range("ApplParent") = Application.Parent
-    Range("ApplPath") = Application.Path
-    Range("ApplActiveWorkbook") = Application.ActiveWorkbook.Name
-    Range("ApplActiveSheet") = Application.ActiveSheet.Name
-    Range("ApplActiveCell") = Application.ActiveCell.Address
-    
-End Sub
-
-
-Sub generateDataToSort()
-    Dim i As Integer
-    
-    With Range("SortArray")
-        For i = 1 To .Rows.Count
-            .Cells(i) = Int((100 * Rnd) + 1)    ' Generate random value between 1 and 100.
-        Next i
-    End With
-
-End Sub
-
-Sub SortWithScreenUpdating()
-    Application.ScreenUpdating = True
-    Call BubbleSort(Range("SortArray"))
-    Range("SortArray").Select
-    MsgBox "Sorting Completed"
-End Sub
-Sub SortWithNoScreenUpdating()
-    Application.ScreenUpdating = False
-    Call BubbleSort(Range("SortArray"))
-    Range("SortArray").Select
-    Application.ScreenUpdating = True
-    MsgBox "Sorting Completed"
-End Sub
-
-Sub BubbleSort(rngToSort As Range)
-    Dim i, j As Integer
-    Dim Temp As Variant
-
-    With rngToSort
-        For j = .Rows.Count To 1 Step -1
-            For i = 1 To j
-                .Cells(i).Interior.ColorIndex = 6
-                .Cells(j).Interior.ColorIndex = 8
-                Application.Wait (Now + TimeValue("0:00:01"))
-                If .Cells(i) > .Cells(j) Then
-                    Temp = .Cells(i)
-                    .Cells(i) = .Cells(j)
-                    .Cells(j) = Temp
-                End If
-                .Cells(i).Interior.ColorIndex = xlColorIndexNone
-                .Cells(j).Interior.ColorIndex = xlColorIndexNone
-            Next i
-        Next j
-    
-    End With
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Macro1()
-Attribute Macro1.VB_Description = "Macro recorded 5/5/2004 by Jim Thompson"
-Attribute Macro1.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro1 Macro
-' Macro recorded 5/5/2004 by Jim Thompson
-'
-
-'
-    Selection.End(xlDown).Select
-End Sub
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'Controls'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
-
-Private Sub CommandButton1_Click()
-ActiveSheet.Next.Select
-Rem Range("A1").Select - broken for some stupid reason
-Rem Selection.Copy
-Rem If Selection.EntireRow.Hidden = False Then
-Rem     MsgBox ("Selection Error")
-Rem End If
-ActiveSheet.Previous.Select
-End Sub
-<<<<<<
-======================
-Invocations
->>>>>>
-Attribute VB_Name = "Invocations"
-Rem       No defined return value
-
-Function INoReturnNoRet()
-End Function
-Function IGetThreeNoRet()
-IGetThreeNoRet = 3
-End Function
-Function IGetFooNoRet()
-IGetFooNoRet = "foo"
-End Function
-Function IGetPINoRet()
-IGetPINoRet = 3.1415926535898
-End Function
-
-Rem       Various return types
-
-Function IGetInteger() As Integer
-IGetInteger = 42
-End Function
-Function IGetString() As String
-IGetString = "baa"
-End Function
-Function IGetDouble() As Double
-IGetDouble = 3.1415926535898
-End Function
-Function IGetSingle() As Single
-IGetSingle = 23
-End Function
-Function IGetBoolean() As Boolean
-IGetBoolean = True
-End Function
-
-Rem       Misc parameter types
-
-Function TakesNothing()
-TakesNothing = 1
-End Function
-Function TakesInteger(arg As Integer) As Integer
-TakesInteger = 21
-End Function
-Function TakesString(arg As String) As Integer
-TakesString = 17
-End Function
-Function TakesDouble(arg As Double) As Integer
-TakesDouble = 38
-End Function
-Function TakesDate(arg As Date) As Integer
-TakesDate = 23
-End Function
-Function TakesRange(arg As Range) As Integer
-TakesRange = 11
-End Function
-
-
-Rem Optional arguments
-Function OptionalArgument(Length As Integer, Optional Width As Variant) As Integer
-If IsMissing(Width) Then
-    OptionalArgument = Length * Length
-Else
-    OptionalArgument = Length * Width
-End If
-End Function
-
-Function OptionalNonVariant(Optional IsZero As Integer) As Integer
-If IsMissing(IsZero) Then
-Rem This never occurs
-    OptionalNonVariant = 23
-Else
-    OptionalNonVariant = 17
-End If
-End Function
-
-<<<<<<
-======================
-ObjectModel
->>>>>>
-Attribute VB_Name = "ObjectModel"
-Function ObjectWorksheetFn() As Double
-ObjectWorksheetFn = WorksheetFunction.Sinh(2.3)
-End Function
-Function ObjectIsVolatile() As Double
-Application.Volatile
-ObjectIsVolatile = 3
-End Function
-Function ObjectRange(a As Range) As Integer
-ObjectRange = a.Column + a.Row + a.Height + a.Width
-End Function
-<<<<<<
-======================
-Syntax
->>>>>>
-Attribute VB_Name = "Syntax"
-Rem       Basic Statements
-Function StmtFor() As Integer
-Dim i As Integer
-Dim j As Integer
-For i = 0 To 10
-    j = j + i
-Next i
-StmtFor = j
-End Function
-Function StmtWhile() As Integer
-Dim i As Integer
-While i < 11
-    i = i + 1
-Wend
-StmtWhile = i
-End Function
-Function StmtWith() As Integer
-With Selection
-    .Orientation = 0
-End With
-StmtWith = 15
-End Function
-
-Rem       Unary Operators
-Function UnaryNot() As Boolean
-UnaryNot = Not False
-End Function
-
-Rem       Comparison Operators
-Function BinaryIsGreater() As Boolean
-BinaryIsGreater = 3 > 2
-End Function
-Function BinaryIsGreaterEqual() As Boolean
-BinaryIsGreaterEqual = 2 >= 2
-End Function
-Function BinaryIsLess() As Boolean
-BinaryIsLess = 2 < 2
-End Function
-Function BinaryIsLessEqual() As Boolean
-BinaryIsLessEqual = 4 <= 4
-End Function
-Function BinaryIsEqual() As Boolean
-BinaryIsEqual = 4 = 4
-End Function
-
-Rem       Arithmetic Operators
-Function BinaryAdd() As Integer
-BinaryAdd = 2 + 3
-End Function
-Function BinarySub() As Integer
-BinarySub = 5 - 7
-End Function
-Function BinaryMult() As Integer
-BinaryMult = 2 * 7
-End Function
-Function BinaryDivide() As Integer
-BinaryDivide = 17 / 6
-End Function
-<<<<<<
-======================
-RecordedMacros
->>>>>>
-Attribute VB_Name = "RecordedMacros"
-Sub Boldify()
-Attribute Boldify.VB_Description = "Macro recorded 20/04/2004 by Michael"
-Attribute Boldify.VB_ProcData.VB_Invoke_Func = "t\n14"
-'
-' Boldify Macro
-' Macro recorded 20/04/2004 by Michael
-'
-' Keyboard Shortcut: Ctrl+t
-'
-    Selection.Font.Bold = True
-End Sub
-Sub Italicize()
-Attribute Italicize.VB_Description = "Second Macro description"
-Attribute Italicize.VB_ProcData.VB_Invoke_Func = "J\n14"
-'
-' Italicize Macro
-' Second Macro description
-'
-' Keyboard Shortcut: Ctrl+Shift+J
-'
-    Selection.Font.Italic = True
-End Sub
-Sub Complex()
-Attribute Complex.VB_Description = "Daft thing ..."
-Attribute Complex.VB_ProcData.VB_Invoke_Func = "C\n14"
-'
-' Complex Macro
-' Daft thing ...
-'
-' Keyboard Shortcut: Ctrl+Shift+C
-'
-    ActiveCell.FormulaR1C1 = "2"
-    Range("F8").Select
-    ActiveCell.FormulaR1C1 = "3"
-    Range("F9").Select
-    Selection.Font.Bold = True
-    ActiveCell.FormulaR1C1 = "5"
-    Range("F10").Select
-    ActiveCell.FormulaR1C1 = "=R[-3]C+R[-1]C"
-    Range("F11").Select
-    With Selection.Font
-        .Name = "Arial Black"
-        .Size = 10
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveCell.FormulaR1C1 = "Arial Black"
-    Range("F12").Select
-    ActiveCell.FormulaR1C1 = "Centered"
-    Range("F13").Select
-    ActiveCell.FormulaR1C1 = "Left"
-    Range("F14").Select
-    ActiveCell.FormulaR1C1 = "Right"
-    Range("F12").Select
-    With Selection
-        .HorizontalAlignment = xlCenter
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Range("F13").Select
-    With Selection
-        .HorizontalAlignment = xlLeft
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Range("F14").Select
-    With Selection
-        .HorizontalAlignment = xlRight
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Range("F15:G15").Select
-    ActiveCell.FormulaR1C1 = "Joiined"
-    Range("F15:G15").Select
-    Range("G15").Activate
-    With Selection
-        .HorizontalAlignment = xlCenter
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .IndentLevel = 0
-        .ShrinkToFit = False
-        .ReadingOrder = xlContext
-        .MergeCells = False
-    End With
-    Selection.Merge
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-    Dim xlWkBook As Workbook
-    If (FileSystem.Dir(Application.StartupPath & "\" & TEMPLATE_NAME & ".lnk") = (TEMPLATE_NAME & ".lnk")) Then
-        Kill (Application.StartupPath & "\" & TEMPLATE_NAME & ".lnk")
-    End If
-    Call AddOleInsertVisioDrawingButton
-    ThisWorkbook.Saved = True
-    If Windows.Count = 0 Then
-    If Workbooks(1).IsInplace Then
-            Workbooks.Add
-        End If
-    End If
-
-    
- End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-InsertButtonMacros
->>>>>>
-Attribute VB_Name = "InsertButtonMacros"
-Const BUTTON_BEFORE$ = "&Drawing" 'Button before the insertion point, check localized versions of Excel
-Const STD_TOOLBAR$ = "Standard" 'Excel standard toobar name, check localized versions of Excel
-Const BUTTON_CAPTION$ = "Insert Visio Drawing"    'The caption to use for the button
-'Do not localize below this point
-Const MACRO_NAME$ = "InsertVisioDrawing"    'The name of the function in the VisioMacros module
-Const MODULE_NAME$ = "VisioMacros"    'The name of the module containing the insert drawing macro
-Global Const TEMPLATE_NAME$ = "VisBut97.XLS" '(Do not localise) the name of this template
-Global Const OLD_TEMPLATE_NAME$ = "Insert Visio Button.XLS" 'the name of the Visio 5.0 Excel Macro
-Sub AddOleInsertVisioDrawingButton()
-Dim nButtonPos
-Dim nButtons
-Dim i
-Dim lpszButtonName$
-Dim strCantAdd_
-Dim strError_
-Dim msoButton As CommandBarButton
-Dim msoVisButton As CommandBarButton
-Dim bPresent As Boolean
-
-
-    On Error GoTo -1: On Error GoTo errAddButton
-    
-
-    If Not CommandBars(STD_TOOLBAR).Visible Then
-        CommandBars(STD_TOOLBAR).Visible = True
-    End If
-
-    nButtonPos = 0
-    nButtons = Application.CommandBars(STD_TOOLBAR).Controls.Count - 1
-
-    If nButtons >= 0 Then
-        ' First we look to see if a Visio button already exists.
-
-        For i = 1 To nButtons
-            lpszButtonName$ = Application.CommandBars(STD_TOOLBAR).Controls(i).Caption
-            If lpszButtonName$ = BUTTON_CAPTION Then
-                bPresent = False
-                For x = 1 To (Len(Application.CommandBars(STD_TOOLBAR).Controls(i).OnAction) - Len(OLD_TEMPLATE_NAME))
-                If Mid(Application.CommandBars(STD_TOOLBAR).Controls(i).OnAction, x, Len(OLD_TEMPLATE_NAME)) = OLD_TEMPLATE_NAME Then
-                    bPresent = True
-                    Application.CommandBars(STD_TOOLBAR).Controls(i).Delete
-
-                End If
-                Next x
-                If Not bPresent Then GoTo Done
-            End If
-        Next i
-
-        If ((FileSystem.Dir(Application.Path & "\XLStart\" & OLD_TEMPLATE_NAME & ".LNK") = (OLD_TEMPLATE_NAME & ".LNK")) Or (FileSystem.Dir(Application.Path & "\XLStart\" & OLD_TEMPLATE_NAME & ".LNK") = (OLD_TEMPLATE_NAME & ".lnk"))) Then
-            Kill (Application.Path & "\XLStart\" & OLD_TEMPLATE_NAME & ".LNK")
-        End If
-        'if we didn't find a Visio button, find a location to put one
-        For i = 1 To nButtons
-            lpszButtonName$ = Application.CommandBars(STD_TOOLBAR).Controls(i).Caption
-    
-            If lpszButtonName$ = BUTTON_BEFORE Then
-                nButtonPos = i
-                Exit For
-            End If
-        Next i
-
-    End If
-    'If the Drawing toolbar button does not exist, tack the Visio button onto the end
-    If nButtonPos = 0 Then nButtonPos = nButtons + 1
-    
-    If nButtonPos > 0 Then
-        If 0 = fExists Then
-            Set msoButton = Application.CommandBars(STD_TOOLBAR).Controls.Add(msoControlButton, 1, 0, nButtonPos)
-            msoButton.OnAction = ThisWorkbook.Path & "\" & TEMPLATE_NAME & "!" & MACRO_NAME
-            msoButton.Caption = BUTTON_CAPTION
-            msoButton.TooltipText = BUTTON_CAPTION
-            'Get the stuff we need out of the Visio template
-            ThisWorkbook.Sheets(1).Shapes(1).CopyPicture
-            Rem ---- Make sure the STD_TOOLBAR Toolbar is showing, if it isn't
-            Rem ---- then show it.
-            msoButton.PasteFace
-        End If
-
-    Else
-        MsgBox strCantAdd_, strError_, 48
-    End If
-   
-Done:
-  
-Exit Sub
-errAddButton:
- 
-End Sub
-<<<<<<
-======================
-VisioMacros
->>>>>>
-Attribute VB_Name = "VisioMacros"
-Public Sub InsertVisioDrawing()
-    
-    Dim xlActiveSheet As Object
-    
-    'ThisWorkbook.Windows(1).Visible = False
-    
-    Set xlActiveSheet = Application.ActiveSheet
-    
-    Application.ScreenUpdating = False
-    If Windows.Count = 0 Or xlActiveSheet Is Nothing Then
-        Workbooks.Add
-        Set xlActiveSheet = Application.ActiveSheet
-    End If
-       
-    xlActiveSheet.Shapes.AddOLEObject ("Visio.Drawing")
-    xlActiveSheet.OLEObjects(ActiveSheet.OLEObjects.Count).Activate
-    
-    Application.ScreenUpdating = True
-
-    If Workbooks.Count = 1 Then
-        Application.Tasks(Application.Name).Close
-    End If
-    
-End Sub
-<<<<<<
-Project Name : 'Sample Flowchart Data.XLS'
-Quirk - duff tag length======================
-General
->>>>>>
-Attribute VB_Name = "General"
-
-
-
-
-
-Const strToolbar = "Standard"
-Const szDataShtName = "Flowchart Wizard Data"
-Const szXLCommandLine = "/excel"
-Const szFromExcel = "fromexcel"
-Const szFromExcelOnClose = "excelonclose"
-Const szRunWizrdErr = "Unable to locate Flowchart Wizard."
-Const strButtonName = "Visio Import Flowchart Data Wizard"    ' The button name is also used as the ToolTip.
-Const szSaveNow = "You must save your Excel Workbook before running the Visio Import Flowchart Data Wizard.  Would you like to save it now?"
-Const szNotSaved = "Please save your Excel Workbook before running the Visio Import Flowchart Data Wizard."
-Const szExitWithoutRun = "Would you like to export your Excel workbook to Visio now?"
-Const iButtonID = 231                       ' ID of blank button
-
-Dim bRunWizardOnClose As Integer    ' True if run on close, False otherwise
-Dim lRetVal As Long
-Dim iSaveNow As Integer
-Dim iRunWizardNow As Integer
-Dim iHasWizardStarted As Integer
-Dim szFName As String
-Dim objFltToolbar As Toolbar
-
-Sub Auto_Open()
-Attribute Auto_Open.VB_ProcData.VB_Invoke_Func = " \n14"
-
-    'Add Export Wizard Button
-    AddExportWizardButton
-    
-    Worksheets("Shapes Worksheet").Activate
-    
-    ' AddFloatToolbar
-    
-    ' Set the wizard tracker to 0
-    iHasWizardStarted = 0
-    
-    ' initialize to False
-    bRunWizardOnClose = False
-    
-    
-End Sub
-
-Sub Auto_Close()
-Attribute Auto_Close.VB_ProcData.VB_Invoke_Func = " \n14"
-    
-    'Remove Export Wizard Button
-    RemoveExportWizardButton
-        
-    ' If the wizard hasn't yet been started, ask the user if wizard should be started.
-    If iHasWizardStarted = 0 Then
-        If MsgBox(szExitWithoutRun, vbYesNo + vbQuestion, "Visio Import Flowchart Data Wizard") = 6 Then
-            If Not (Application.ThisWorkbook.Saved) Then
-                If MsgBox(szSaveNow, vbYesNo + vbQuestion, "Visio Import Flowchart Data Wizard") = 6 Then
-                    ThisWorkbook.Save
-                    Call RunExportChartWizard
-                    bRunWizardOnClose = True
-                End If
-            Else
-                Call RunExportChartWizard
-                bRunWizardOnClose = True
-            End If
-        End If
-    End If
-        
-Exit Sub
-
-    
-
-End Sub
-
-
-Private Sub AddExportWizardButton()
-' Add the "InsertVisioDrawing" button to Excel's standard toolbar
-' if the button does not already exist.
-
-    Set btns = Toolbars(strToolbar).ToolbarButtons
-    Set btn = ButtonsIndex(btns, strButtonName)
-    
-    ' Check if toolbar button already exists
-    If Not (btn Is Nothing) Then
-        btn.Delete
-    End If
-    
-    ' Add a blank button to the Standard toolbar,
-    ' after the "Drawing" toolbar button.
-    iLoc = ButtonsLoc(btns, "Drawing")
-    If iLoc = 0 Then
-        Set btn = btns.Add(iButtonID)
-    Else
-        Set btn = btns.Add(iButtonID, iLoc + 1)
-    End If
-    btn.Name = strButtonName
-    
-    ' Copy the button bitmap to the clipboard.
-    ' Paste it onto the button.
-    Set objWorkbook = Application.ThisWorkbook
-    objWorkbook.Sheets(szDataShtName).DrawingObjects(1).CopyPicture
-    btn.PasteFace
-                
-    ' Set the macro the toolbar button will run.
-    btn.OnAction = "RunExportChartWizard"
-End Sub
-
-Private Sub RemoveExportWizardButton()
-
-    Set btns = Toolbars(strToolbar).ToolbarButtons
-    Set btn = ButtonsIndex(btns, strButtonName)
-    
-    If Not (btn Is Nothing) Then
-        btn.Delete
-    End If
-        
-End Sub
-
-
-Sub RunExportChartWizard()
-Attribute RunExportChartWizard.VB_ProcData.VB_Invoke_Func = " \n14"
-    
-    Dim szExportWizExe As String
-    Dim szTempName As String
-    Dim szFileName As String
-    Dim szCommandLine As String
-    
-    On Error GoTo ErrRunWizard
-    
-    ' Keep track of the fact that the wizard started
-    iHasWizardStarted = 1
-    
-    If Not (Application.ThisWorkbook.Saved) Then
-        ' Alert user to save work before continuing
-        MsgBox szNotSaved, 48
-        ' Bring up the SaveAs Dialog Box to do the saving
-        Do
-           szName = Application.GetSaveAsFilename
-        Loop Until szName <> False
-        ThisWorkbook.SaveAs Filename:=szName
-    End If
-            
-
-    szOrgWizExe = Application.ThisWorkbook.Worksheets(szDataShtName).Cells(1).Formula
-    
-    szFileName = Application.ThisWorkbook.FullName
-    If bRunWizardOnClose = True Then
-        szCommandLine = szXLCommandLine & "=" & Chr$(34) & szFromExcelOnClose & szFileName & Chr$(34)
-    Else
-        szCommandLine = szXLCommandLine & "=" & Chr$(34) & szFromExcel & szFileName & Chr$(34)
-    End If
-    
-    lRetVal = Shell(szOrgWizExe & " " & szCommandLine, 5)
-        
-Exit Sub
-        
-ErrRunWizard:
-    MsgBox szRunWizrdErr, 48
-End Sub
-
-
-Private Function ButtonsIndex(ByVal Buttons As Object, ByVal bname As String) As Object
-' Index any collection by name.
-' Returns the object with a given name.
-' Returns Nothing if not found.
-
-    For Each btn In Buttons
-        If btn.Name = bname Then
-            Set ButtonsIndex = btn
-            Exit For
-        End If
-    Next
-    
-End Function
-
-
-Private Function ButtonsLoc(ByVal Buttons As Object, ByVal bname As String) As Integer
-' Returns the location of a button with a given name
-' or zero if not found.
-
-    n = Buttons.Count
-    For i = 1 To n
-        If Buttons(i).Name = bname Then
-            ButtonsLoc = i
-            Exit For
-        End If
-    Next
-End Function
-
-
-Private Function AddFloatToolbar()
-' Creates a floating toolbar for the add shapes and
-' add connectors buttons
-
-    Dim cToolbars As Integer, cBuiltin As Integer
-    Dim bToolbarOpen As Boolean
-    
-    Dim iLocShpBtn As Integer, iLocConBtn As Integer, iLocExpBtn As Integer
-    Dim iLocHlpBtn As Integer, iLocVisBtn As Integer
-    
-    cToolbars = Toolbars.Count
-    cBuiltin = 0
-    
-    ' Set a flag if the toolbar is already open.
-    For i = 1 To cToolbars
-        If Toolbars.Item(i).Name = strButtonName Then
-            Toolbars.Item(i).Left = 200
-            Toolbars.Item(i).Top = 100
-            Toolbars.Item(i).Visible = True
-            bToolbarOpen = True
-        End If
-    Next i
-    
-
-
-End Function
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag lengthProject Name : 'VBAProject'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    set_work_mode
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    CheckUser
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    Application.ScreenUpdating = True
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    Application.Calculate
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-    
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    
-    With ThisWorkbook
-        xlRestoreView
-        .Application.DisplayAlerts = False
-        .Save
-    End With
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(RM_QTR_SHEET)
-        .Select
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "Clexane[FM] ver 1.0"
-Public Const PROGRAM_FILENAME As String = "clexane-fm"
-Public Const PROGRAM_EXPORTNAME As String = "fm-export-"
-Public Const PROGRAM_IMPORTNAME As String = "rm-export-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "P40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-'    Dim r_sel As Range
-'    If Not chk_input_range(Target) Then
-'        Set r_sel = Range(CINP_AREA)
-'    Else
-'        Set r_sel = Target
-'    End If
-'
-'    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-'        Set r_sel = r_sel.Cells(1, 1)
-'    End If
-'
-'    If r_sel.count = 1 Then
-'        Range("LAST_FOCUS") = r_sel.address
-'        InpRowSelect r_sel
-'    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{45F91340-020C-4762-8C2B-14E6F5375F21}{C544EEE0-1237-49FD-B4F4-45C95DDB8922}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{DF5C686A-EAE3-49BA-8115-FE816E2D39EC}{48D2D902-BB57-4E5D-8E3E-DE019AAA3DCB}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            test = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-        End With
-        If test <> 0 Then
-            If test < 0 Then
-                If vbYes = MsgBox("��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                        vbYesNo, PROGRAM_NAME) Then
-                    test = 1
-                End If
-            End If
-            If test > 0 Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{F17F06E4-A8A6-41A3-9FED-D0AC38822956}{458758E5-729D-4F56-9D38-AB3E5822B018}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{A9872FBD-E473-4AE0-9292-983BA36D1587}{906EBD8D-FA59-4DD0-BBC0-F7370FBEEB1B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{EEA1A7D4-FC90-41EB-B07A-2394D6ADAC87}{F006F648-CB60-4054-8125-4E6FAF38821B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    dlg_ui.Show
-    Worksheets(REGS_SHEET).Calculate
-    
-    If dlg_ui.Tag = vbOK Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "password"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(REP_QTR_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & .risk_percent & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & .risk_percent & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .DisplayStatusBar = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{340DD43E-515B-4263-825A-A255A94425B7}{CEE59553-DC72-40C2-99DE-3AB9AE67989B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{A2D9F2DF-DECC-4DE7-9E52-73E543C4AD9F}{7D8D098F-D14A-4204-9B3D-65C54EB47462}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{8C52BEE1-3ADE-4F5C-AACA-0C97B456CBD2}{E38DF44D-9857-40F3-8374-8CFE5C56BFDB}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{604DF175-692F-4321-9AAA-1442FA3AD341}{F0BCE93C-6F12-4F69-BC41-B2299FAA7ADE}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeRM(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM reg_man"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeRM = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "reg_man", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeRM = insertRecordset("mgr_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Public Type tREPCONVERTION
-    old_rep_id As Long
-    new_lp_id As Long
-End Type
-
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeRM(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeRM = dbMergeRM(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeREP(objREP() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objREP, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rm_files() As String, fm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data fm_file
-    
-    For i = 1 To UBound(rm_files)
-        
-        Dim rm_file As String
-        'setup input and output files
-        rm_file = rm_files(i)
-        
-        Dim new_rm_id As Long
-        ' insert REP data and get new rep_id
-        new_rm_id = MergeRM(rm_file, fm_file)
-        
-        'insert all REP for new generateg rm_id
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rm_file, fm_file, new_rm_id
-        
-        'insert quarter data using new rep_id
-        MergeQTR rm_file, fm_file, new_rm_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rm_file, fm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-Sub test_import()
-    Dim MyPath As String
-    Dim flist() As String
-    Dim i As Integer
-    MyPath = "g:\"
-    i = GetDBList(MyPath, flist)
-    If i > 0 Then
-        MergeGlobal flist, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-    End If
-End Sub
-<<<<<<
-======================
-dbxyz_test
->>>>>>
-Attribute VB_Name = "dbxyz_test"
-Option Explicit
-
-Sub mrg_main()
-    Dim rep_files(1 To 2) As String
-    Dim rm_file As String
-    
-    'setup input and output files
-    rep_files(1) = "e:\work\aventis\clexane-mr1.mdb"
-    rep_files(2) = "e:\work\aventis\clexane-mr2.mdb"
-    
-    'setup output file
-    rm_file = "e:\work\aventis\clexane-rm.mdb"
-    
-    MergeGlobal rep_files, rm_file
-End Sub
-
-Sub ttt()
-    Dim rcd() As tREPID_COMMON
-    Dim i As Long
-    i = Get_REP_CommonList_by_QTR(rcd, "2003-III")
-End Sub
-
-Sub getallreps()
-    Dim i As Integer
-    Dim j As Integer
-    Dim k As Integer
-    Dim s As String
-    
-    Dim allREPID() As tREPID
-    Dim allQTRREP() As tQTR
-    Dim allLPU() As tLPU
-    
-    i = GetAll_REPID_Records(allREPID)
-    
-    If i > 0 Then
-        For i = 1 To UBound(allREPID)
-            j = GetAll_QTR_Records_by_REP(allQTRREP, "%", allREPID(i).rep_id)
-            If j > 0 Then
-                For j = 1 To UBound(allREPID)
-                    k = GetAll_LPU_byQTR(allLPU, allQTRREP(j).entry_date, allREPID(i).rep_id)
-                    If k > 0 Then
-                        For k = 1 To UBound(allLPU)
-                            MsgBox allLPU(k).name
-                        Next k
-                    End If
-                Next j
-            End If
-        Next i
-    End If
-End Sub
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-        End If
-    Next i
-
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            def_dir = GetWBPath(ThisWorkbook.FullName)
-            If GetImportDirectory(def_dir, flist) Then
-                Dim db_list() As String
-                i = GetDBList(flist(0), db_list)
-                If i > 0 Then
-                    MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-                End If
-            End If
-            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_ALLOWMULTISELECT + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-mImport2
->>>>>>
-Attribute VB_Name = "mImport2"
-Option Explicit
-
-Sub FOpen()
-    Dim flist As String
-    Dim fileToOpen, s
-    flist = ""
-    fileToOpen = Application _
-        .GetOpenFileName("Data Files (*.mdb), mr*.mdb", title:="������ ������", MultiSelect:=True)
-    If fileToOpen <> False Then
-        For Each s In fileToOpen
-            flist = flist & s & "; "
-        Next s
-        MsgBox "Open " & flist
-    End If
-End Sub
-
-Sub t2()
-    Dim d As dlgImprtDB
-    Set d = New dlgImprtDB
-    d.Show
-End Sub
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{F682E458-9834-4879-8411-9164089DF582}{EDF8D6E7-B9DC-4122-B717-981CD221F3E8}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    set_work_mode
-    
-    CheckUser
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    Application.ScreenUpdating = True
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-    Application.Calculate
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-    
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    
-    With ThisWorkbook
-        .Application.DisplayAlerts = False
-        xlRestoreView
-        .Save
-    End With
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(REP_QTR_SHEET)
-        .Select
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREP
-    
-    cRep = GetREPRecord
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-    
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    i = GetAll_QTR_Records(objQTR, "%")
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList(qcd)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_plan
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CRow_Width Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-    
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub DO_New_qtr()
-    Dim res As Variant
-    Dim objQTR As tQTR
-    Dim s As String
-    s = GetLastQtr
-    objQTR.entry_date = GetNextQTR(s)
-    
-    If objQTR.entry_date = "" Then
-        Exit Sub
-    End If
-    
-    DO_Price_qtr objQTR.entry_date
-
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    
-    qtr = Get_QTR_Record(ent_date)
-    
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-    
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-    
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_plan
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-    
-    dlg_nq.Show
-    res = dlg_nq.Tag
-    
-    If res = vbOK Then
-        With dlg_nq
-            If Not IsNumeric(.tb_bdgt_avts) Then
-                MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-            Else
-                If .tb_bdgt_avts = 0 Then
-                    MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                    Exit Sub
-                End If
-            End If
-            Dim bool As Boolean
-            bool = IsNumeric(.tb_ClxnH20mg) _
-                And IsNumeric(.tb_ClxnH40mg) _
-                And IsNumeric(.tb_ClxnT40mg) _
-                And IsNumeric(.tb_ClxnC_ACS) _
-                And IsNumeric(.tb_ClxnC_IM)
-            If Not bool Then
-                MsgBox "������� ��������� �����", vbOK, PROGRAM_NAME
-                Exit Sub
-            End If
-            qtr.sale_plan = .tb_bdgt_avts
-            qtr.entry_date = .tb_qtr_name
-            qtr.ClxnH20mg = .tb_ClxnH20mg
-            qtr.ClxnH40mg = .tb_ClxnH40mg
-            qtr.ClxnT40mg = .tb_ClxnT40mg
-            qtr.ClxnC_ACS = .tb_ClxnC_ACS
-            qtr.ClxnC_IM = .tb_ClxnC_IM
-        End With
-        Insert_QTR_Record qtr
-    End If
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = False
-            .Range("ent_date") = ent_date
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        Dim i As Integer
-        i = MsgBox("������� ������ �� ������ [" & ent_date & "]?", vbDefaultButton2 + vbOKCancel, PROGRAM_NAME)
-        If i = vbOK Then
-            Dim objQTR As tQTR
-            If ent_date <> "" Then
-                objQTR.entry_date = ent_date
-                objQTR = Get_QTR_Record(ent_date)
-                Delete_QTR_Record objQTR
-                Worksheets(TITLE_SHEET).Select
-                Worksheets(REP_QTR_SHEET).Select
-            End If
-        End If
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            DO_New_qtr
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            dbExport
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    End Select
-    If idx <> 2 Then
-        With ThisWorkbook
-            .Worksheets(TITLE_SHEET).Select
-            .Worksheets(REP_QTR_SHEET).Select
-        End With
-    End If
-End Sub
-
-Sub Delete_qtr()
-    Dim ent_date As String
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    DO_Delete_qtr ent_date
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma"
-Public Const PROGRAM_VERSION As String = "Clexane[MR] ver 1.3"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-export-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-    
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-    
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-        
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-                   
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-       
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    Range("LAST_FOCUS") = CINP_AREA
-    
-    UpdateLPUList
-    
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CINP_WIDTH Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-    
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-        
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    lpu_id = r
-    
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-    
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-    
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-            
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-        
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-        
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-        
-        Case Else
-            Range("JUMP") = ""
-    End Select
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-    
-    is_input_range = INPUT_NO
-    
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-    
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREP
-    
-    ' ent_date = "%" ' % - all records
-    ent_date = getEnt_date
-    
-    objQTR = Get_QTR_Record(ent_date)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-     
-    ' ������� ���
-    Range("C3:C4").ClearContents
-    cRep = GetREPRecord
-    
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_plan
-    
-
-    
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-        
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-            
-         
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_plan
-            
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-            
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{80F5BB2F-5609-4CB2-84B1-E80CE1E8A90C}{3D34390E-B837-4471-AFE0-B5C8399582D8}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-    
-        Dim objHir As tHIRURGIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.Count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-        
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-    
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-            Application.ScreenUpdating = False
-            
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-            
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{B6A605B8-0DA5-4237-9732-C6EF328660B9}{B79DCFAC-9872-4E14-9F9A-4DD3E710171A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_plan = Round(Range("F13").Value, 0)
-            
-            test = .bdgt_NFG + .bdgt_NMG - .sale_plan
-        End With
-        If test <> 0 Then
-            If test < 0 Then
-                If vbYes = MsgBox("��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                        vbYesNo, PROGRAM_NAME) Then
-                    test = 1
-                End If
-            End If
-            If test > 0 Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Insert_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-    
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_plan
-    
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    objQTR = Get_QTR_Record(ent_date)
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-    
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-        
-        SetupData cLPU
-        
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case INPUT_CHECK
-            
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{9A49AB78-5384-4123-B3D4-70ECF403CCE3}{88B43E2F-B316-403D-AD13-A598E9B13611}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{D31C532A-2C7C-4596-A9A8-E0070AA2354F}{9955E423-13F2-430C-B27E-744B8EB93350}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{475C43B4-C5EF-409D-A491-EE3F7DA14735}{29835B05-A665-4A6A-BDFA-6750CAA14FF0}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREP
->>>>>>
-Attribute VB_Name = "mREP"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-    Dim cUser As tREP
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cUser = GetREPRecord()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cUser.Region
-        .Range("IDX_CITY") = cUser.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cUser.Region
-        .cbCity = cUser.City
-        .tbFName = cUser.FirstName
-        .tbLName = cUser.LastName
-    End With
-    
-    dlg_ui.Show
-    Worksheets(REGS_SHEET).Calculate
-    
-    If dlg_ui.Tag = vbOK Then
-        With cUser
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        SetREPRecord cUser
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_plan As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim SQL As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_plan = 0
-    End With
-        
-    
-    SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_plan = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_plan = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_plan
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_plan & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPU(allLPU() As tLPU) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPU = dbGetAllLPU(dbConnection, allLPU)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPUbyQTR(allLPU() As tLPU, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPUbyQTR = dbGetAllLPUbyQTR(dbConnection, allLPU, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objLPU.id = 0 then insert else update
-Sub Insert_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    If objLPU.id = 0 Then
-        dbInsert_LPU_Record dbConnection, objLPU
-    Else
-        dbUpdate_LPU_Record dbConnection, objLPU
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub Delete_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDelete_LPU_Record dbConnection, objLPU
-    dbCloseConnection dbConnection
-End Sub
-
-Sub Delete_LPU_RecordQTR(ByRef objLPU As tLPU, ent_date As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-    dbCloseConnection dbConnection
-    
-End Sub
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim SQL As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    SQL = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Sub dbInsert_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-  
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu", dbConnection, 2, 2
-    dbRecordset.addnew
-    dbRecordset("name") = objLPU.name
-    dbRecordset("address") = objLPU.address
-    dbRecordset("rep_id") = objLPU.rep_id
-    dbRecordset("beds") = objLPU.beds
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objLPU.id = dbRecordset("id")
-  
-End Sub
-
-Sub dbUpdate_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu SET " & _
-    "name='" & objLPU.name & "'," & _
-    "address='" & objLPU.address & "'," & _
-    "beds=" & objLPU.beds & "," & _
-    "rep_id=" & objLPU.rep_id& & _
-    " WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-
-Function dbGetAllLPU(dbConnection As Object, allLPU() As tLPU) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu"
-    getAll_LPU_SQL = "SELECT * FROM lpu"
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPU = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAllLPUbyQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim where As String
-    where = "WHERE lpu_budget.entry_date like '" & ent_date & "'"
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget " & where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & where & " AND lpu.id=lpu_budget.lpu_id"
-    
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPUbyQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Sub dbDelete_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu " & _
-    "WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Hir_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Ter_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_ACS_RecordsByLPU_ID dbConnection, objLPU.id
-    
-End Sub
-
-Sub dbDelete_LPU_RecordQTR(dbConnection As Object, ByRef objLPU As tLPU, ent_date As String)
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-End Sub
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-Option Explicit
-
-Public Type tREP
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetREPRecord() As tREP
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetREPRecord = dbGetREPRecord(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub SetREPRecord(cUser As tREP)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSetREPRecord dbConnection, cUser
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGetREPRecord(dbConnection As Object) As tREP
-    
-    Dim SQL As String
-    Dim objREP As tREP
-    
-    objREP.FirstName = ""
-    objREP.LastName = ""
-    objREP.Region = 0
-    objREP.City = 0
-    SQL = "SELECT firstname, lastname, region, city FROM " & _
-          "rep"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREP.FirstName = dbRecordset("firstname")
-        objREP.LastName = dbRecordset("lastname")
-        objREP.Region = dbRecordset("region")
-        objREP.City = dbRecordset("city")
-        
-    End If
-    
-    dbGetREPRecord = objREP
-        
-End Function
-
-Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREP.FirstName & "', " & _
-    "'" & objREP.LastName & "', " & _
-    objREP.Region & ", " & _
-    objREP.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "password"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(REP_QTR_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & .risk_percent & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & .risk_percent & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    Dim del_request As Integer
-    Dim allLPU() As tLPU
-    Dim lpu_count As Integer
-    Dim i As Integer
-    Dim tmp_LPU_List As Range
-    Dim tmp_LPU_List_Addr As String
-    Dim r_end As Range
-    Dim dlg As Dlg_lpu_card
-    
-    Set dlg = New Dlg_lpu_card
-    
-    lpu_count = GetAllLPU(allLPU)
-    With Worksheets(VAR_SHEET)
-        Set tmp_LPU_List = .Range("tmp_LPU_List")
-        Set r_end = .Range(tmp_LPU_List, tmp_LPU_List.End(xlDown))
-        Set r_end = .Range(r_end, r_end.End(xlToRight))
-        .Range(tmp_LPU_List, r_end).ClearContents
-    End With
-        
-    If lpu_count <> 0 Then
-        dlg.cbxLPU_List_Enable.Enabled = True
-        For i = 1 To UBound(allLPU)
-            tmp_LPU_List.Cells(i, 1) = allLPU(i).name
-            tmp_LPU_List.Cells(i, 2) = allLPU(i).address
-            tmp_LPU_List.Cells(i, 3) = allLPU(i).beds
-            tmp_LPU_List.Cells(i, 4) = allLPU(i).id
-        Next i
-    Else
-        dlg.cbxLPU_List_Enable.Enabled = False
-    End If
-    
-    tmp_LPU_List_Addr = Worksheets(VAR_SHEET).name & "!" & _
-            Worksheets(VAR_SHEET).Range(tmp_LPU_List, tmp_LPU_List.End(xlDown)).address
-
-    With dlg
-        .cbLPU_List.RowSource = tmp_LPU_List_Addr
-        .cbLPU_List.ListIndex = 0
-        .cbxLPU_List_Enable = False
-        .cbLPU_List.Enabled = False
-        If cLPU.id <> 0 Then
-            .cbxLPU_List_Enable.Enabled = False
-        Else
-            If lpu_count <> 0 Then
-                .cbxLPU_List_Enable.Enabled = True
-            Else
-                .cbxLPU_List_Enable.Enabled = False
-            End If
-        End If
-        .tb_lpu_name.Text = cLPU.name
-        .tb_lpu_address.Text = cLPU.address
-        .tbBedsCount = cLPU.beds
-
-        .Tag = vbCancel
-    End With
-    
-    dlg.Show
-    
-    If Not IsNumeric(dlg.Tag) Then
-        Exit Sub
-    End If
-    
-    If dlg.Tag = vbOK Then
-        Dim n As Variant
-        Dim test As Integer
-        test = 0
-        n = dlg.tbBedsCount.Value
-        If Not IsNumeric(n) Then
-            test = 1
-        Else
-            If n = 0 Then
-                test = 1
-            End If
-        End If
-        If test = 0 Then
-            
-            cLPU.name = dlg.tb_lpu_name.Text
-            cLPU.address = dlg.tb_lpu_address.Text
-            cLPU.beds = dlg.tbBedsCount.Value
-                                    
-            If cLPU.name = "" Or cLPU.address = "" Then
-                test = 2
-            End If
-        End If
-        Select Case test
-            Case 0
-                If dlg.cbxLPU_List_Enable.Enabled = True Then
-                    cLPU.id = tmp_LPU_List.Cells(dlg.cbLPU_List.ListIndex + 1, 4)
-                End If
-                Insert_LPU_Record cLPU
-                ' ��������� ������� ������ ��� ��� � ��������
-                Dim bdgt As tBUDGET
-                bdgt = Get_BDGT_Record(cLPU.id, ent_date)
-                ' ������ ���: ������� ������ ������ � lpu_budget
-                If bdgt.id = 0 Then
-                    bdgt.lpu_id = cLPU.id
-                    bdgt.entry_date = ent_date
-                    Insert_BDGT_Record bdgt
-                End If
-            Case 1
-                MsgBox "������� ��������� ���������� ������ ����� ��� 1!", vbOKOnly, PROGRAM_NAME
-            Case 2
-                MsgBox "������������ � ����� ��� �� ������ ���� �������!", vbOKOnly, PROGRAM_NAME
-        End Select
-    End If
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-    
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-    
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-    
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & "."
-        .Show
-        
-        If .Tag = vbOK Then
-            If .chbDeleteAll.Value Then
-                delete_all = _
-                    MsgBox("��� ������ �� ��� � ������ '" & cLPU.name & _
-                    "' ����� ������� ��������.", vbOK, PROGRAM_NAME)
-                If delete_all = vbOK Then
-                    Delete_LPU_Record cLPU
-                End If
-            Else
-                Delete_LPU_RecordQTR cLPU, ent_date
-            End If
-        End If
-    End With
-    
-    With ThisWorkbook
-        .Worksheets(TITLE_SHEET).Select
-        .Worksheets("LPU_LIST").Select
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Activate
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-        
-    
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-            
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-                
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-                
-        End Select
-    End With
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_plan As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-
-Sub Insert_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTR.id <> 0 Then
-        dbUpdate_QTR_Record dbConnection, objQTR
-    Else
-        dbInsert_QTR_Record dbConnection, objQTR
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTR_Record(ent_date As String) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, ent_date)
-    If i <> 0 Then
-        Get_QTR_Record = allQTR(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records(ByRef all_QTR() As tQTR, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTR_Records = dbGetAll_QTR_Records(dbConnection, all_QTR, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTR_Record dbConnection, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTR.ID <> 0 then updatre else insert
-Sub dbInsert_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTR
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_plan
-        dbRecordset("rep_id") = .rep_id
-        dbRecordset("ClxnH20mg") = .ClxnH20mg
-        dbRecordset("ClxnH40mg") = .ClxnH40mg
-        dbRecordset("ClxnT40mg") = .ClxnT40mg
-        dbRecordset("ClxnC_IM") = .ClxnC_IM
-        dbRecordset("ClxnC_ACS") = .ClxnC_ACS
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTR.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim Update_SQL As String
-    
-    With objQTR
-        Update_SQL = "UPDATE quarter SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rep_id=" & .rep_id & "," & _
-            "sale_plan=" & .sale_plan & "," & _
-            "ClxnH20mg=" & .ClxnH20mg & "," & _
-            "ClxnH40mg=" & .ClxnH40mg & "," & _
-            "ClxnT40mg=" & .ClxnT40mg & "," & _
-            "ClxnC_IM=" & .ClxnC_IM & "," & _
-            "ClxnC_ACS=" & .ClxnC_ACS & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTR_Records(dbConnection As Object, all_QTR() As tQTR, ent_date As String) As Integer
-    
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter WHERE entry_date like '" & ent_date & "'"
-    getAll_QTR_SQL = "SELECT * FROM quarter WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTR_Records = QTR_Count
-    
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_plan = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter " & _
-    "WHERE id=" & objQTR.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Hir_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Ter_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_ACS_RecordsByQTR dbConnection, objQTR.entry_date
-       
-End Sub
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList(ByRef qcd() As tQTR_COMMON) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList = dbGet_QTR_CommonList(dbConnection, qcd)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList(dbConnection As Object, ByRef qcd() As tQTR_COMMON) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, "%")
-    dbGet_QTR_CommonList = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_plan
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .DisplayStatusBar = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{CB598DF8-D744-4C0F-8E95-979C0EB2D31F}{07ECD06D-1C59-42FA-8A05-5C7059B89B88}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{7BCBD561-C46C-4F55-88AD-48A260810549}{EFA3446E-8602-4D47-A205-3F681A9D4151}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAllLPUbyQTR(dbConnection, allLPU, objQTR.entry_date)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{D9DD256D-F23B-4FD6-88F0-FE8DAA2B3BB1}{7AF34CC3-6E90-457A-A3A8-7BF91A89A158}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{E3301CDB-CB6A-4294-B02F-936DCCCFF7FB}{AA37504B-6245-47E7-AEC0-729CA3A51508}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tID_REP
-    id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Public Type tID_REP_COMMON
-    id_rep As tID_REP
-    i_qtr As Long
-    qtrs As tQTR_COMMON
-End Type
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub t()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    set_work_mode
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    CheckUser
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    Application.ScreenUpdating = True
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    Application.Calculate
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-    
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    
-    With ThisWorkbook
-        xlRestoreView
-        .Application.DisplayAlerts = False
-        .Save
-    End With
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(RM_QTR_SHEET)
-        .Select
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "Clexane[RM] ver 1.0"
-Public Const PROGRAM_FILENAME As String = "clexane-rm"
-Public Const PROGRAM_EXPORTNAME As String = "rm-export-"
-Public Const PROGRAM_IMPORTNAME As String = "mr-export-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "P40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-'    Dim r_sel As Range
-'    If Not chk_input_range(Target) Then
-'        Set r_sel = Range(CINP_AREA)
-'    Else
-'        Set r_sel = Target
-'    End If
-'
-'    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-'        Set r_sel = r_sel.Cells(1, 1)
-'    End If
-'
-'    If r_sel.count = 1 Then
-'        Range("LAST_FOCUS") = r_sel.address
-'        InpRowSelect r_sel
-'    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{A5C75EBA-B704-40A8-8703-4024BEBD3C62}{7FC65B94-0A91-420F-9DF8-7707F2D795DE}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{889AFC38-1F8F-490E-A345-A59FE5C6253E}{35BDEA9B-C00F-4BA2-BC41-F1D5364C2DFD}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            test = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-        End With
-        If test <> 0 Then
-            If test < 0 Then
-                If vbYes = MsgBox("��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                        vbYesNo, PROGRAM_NAME) Then
-                    test = 1
-                End If
-            End If
-            If test > 0 Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{54164808-BEEF-4504-84F7-7D50FB8316D5}{D4B9E98D-F32D-4EE7-B1C5-E9E2FCD7143A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{D4A3C142-06CF-4021-88A8-2E2128F43892}{89EBA4E1-4361-4E6E-8736-B0C415B09198}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{B2D56DB4-2D56-4C94-8B79-7CD6E29F4FFC}{1749C8F9-6882-464E-B9A9-669E72EEAC4D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    dlg_ui.Show
-    Worksheets(REGS_SHEET).Calculate
-    
-    If dlg_ui.Tag = vbOK Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "password"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(REP_QTR_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & .risk_percent & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & .risk_percent & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .DisplayStatusBar = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{24511B6B-2B0B-44FC-89C5-FF43FB41B0A0}{5414F65F-196D-435B-AD61-075BCD7AFFDF}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{1644D09B-FC49-43ED-8016-8B6C094F4CFD}{73243B9F-5178-4882-A692-756A3F34EABA}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{8864A941-8AE3-4960-A65E-E5DC897679D4}{27B98C83-0140-4FB2-A117-ECEDB41A834D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{8B7F84B3-4C60-489E-BA7D-9D25B479920C}{02D0D5BB-CB5C-44ED-B18C-0FA89CF34D3A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-Sub test_import()
-    Dim MyPath As String
-    Dim flist() As String
-    Dim i As Integer
-    MyPath = "g:\"
-    i = GetDBList(MyPath, flist)
-    If i > 0 Then
-        MergeGlobal flist, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-    End If
-End Sub
-<<<<<<
-======================
-dbxyz_test
->>>>>>
-Attribute VB_Name = "dbxyz_test"
-Option Explicit
-
-Sub mrg_main()
-    Dim rep_files(1 To 2) As String
-    Dim rm_file As String
-    
-    'setup input and output files
-    rep_files(1) = "e:\work\aventis\clexane-mr1.mdb"
-    rep_files(2) = "e:\work\aventis\clexane-mr2.mdb"
-    
-    'setup output file
-    rm_file = "e:\work\aventis\clexane-rm.mdb"
-    
-    MergeGlobal rep_files, rm_file
-End Sub
-
-Sub ttt()
-    Dim rcd() As tREPID_COMMON
-    Dim i As Long
-    i = Get_REP_CommonList_by_QTR(rcd, "2003-III")
-End Sub
-
-Sub getallreps()
-    Dim i As Integer
-    Dim j As Integer
-    Dim k As Integer
-    Dim s As String
-    
-    Dim allREPID() As tREPID
-    Dim allQTRREP() As tQTR
-    Dim allLPU() As tLPU
-    
-    i = GetAll_REPID_Records(allREPID)
-    
-    If i > 0 Then
-        For i = 1 To UBound(allREPID)
-            j = GetAll_QTR_Records_by_REP(allQTRREP, "%", allREPID(i).rep_id)
-            If j > 0 Then
-                For j = 1 To UBound(allREPID)
-                    k = GetAll_LPU_byQTR(allLPU, allQTRREP(j).entry_date, allREPID(i).rep_id)
-                    If k > 0 Then
-                        For k = 1 To UBound(allLPU)
-                            MsgBox allLPU(k).name
-                        Next k
-                    End If
-                Next j
-            End If
-        Next i
-    End If
-End Sub
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-        End If
-    Next i
-
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            def_dir = GetWBPath(ThisWorkbook.FullName)
-            If GetImportDirectory(def_dir, flist) Then
-                Dim db_list() As String
-                i = GetDBList(flist(0), db_list)
-                If i > 0 Then
-                    MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-                End If
-            End If
-            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_ALLOWMULTISELECT + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-mImport2
->>>>>>
-Attribute VB_Name = "mImport2"
-Option Explicit
-
-Sub FOpen()
-    Dim flist As String
-    Dim fileToOpen, s
-    flist = ""
-    fileToOpen = Application _
-        .GetOpenFileName("Data Files (*.mdb), mr*.mdb", title:="������ ������", MultiSelect:=True)
-    If fileToOpen <> False Then
-        For Each s In fileToOpen
-            flist = flist & s & "; "
-        Next s
-        MsgBox "Open " & flist
-    End If
-End Sub
-
-Sub t2()
-    Dim d As dlgImprtDB
-    Set d = New dlgImprtDB
-    d.Show
-End Sub
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{F249176D-486B-46DB-9FFF-6CFEBC0CB94B}{8245F8BD-0F9B-47F4-947B-4ED30DA63EF1}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    set_work_mode
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    CheckUser
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    Application.ScreenUpdating = True
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    Application.Calculate
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-    
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    
-    With ThisWorkbook
-        xlRestoreView
-        .Application.DisplayAlerts = False
-        .Save
-    End With
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(RM_QTR_SHEET)
-        .Select
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "Clexane[RM] ver 1.0"
-Public Const PROGRAM_FILENAME As String = "clexane-rm"
-Public Const PROGRAM_EXPORTNAME As String = "rm-export-"
-Public Const PROGRAM_IMPORTNAME As String = "mr-export-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "P40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-'    Dim r_sel As Range
-'    If Not chk_input_range(Target) Then
-'        Set r_sel = Range(CINP_AREA)
-'    Else
-'        Set r_sel = Target
-'    End If
-'
-'    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-'        Set r_sel = r_sel.Cells(1, 1)
-'    End If
-'
-'    If r_sel.count = 1 Then
-'        Range("LAST_FOCUS") = r_sel.address
-'        InpRowSelect r_sel
-'    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{61578A1F-A40D-40D9-BDC5-9B19909352C7}{EBB173CA-630F-4686-8122-1980F1071257}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{EB7A1A05-DDD1-4FB8-8061-EA4E6E0F2909}{1F1B7B18-81E4-4A41-9D49-138004069095}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            test = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-        End With
-        If test <> 0 Then
-            If test < 0 Then
-                If vbYes = MsgBox("��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                        vbYesNo, PROGRAM_NAME) Then
-                    test = 1
-                End If
-            End If
-            If test > 0 Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{C153FD2A-1AF3-4CA1-94C8-33DFC836F451}{21F1E6B0-03F8-4687-B1AE-A865D971B51F}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{5764DEB2-CAF6-45EF-B0F4-5464E8CDF848}{B9786D4A-134B-4A37-BFCD-40AEC0764940}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{6DBD00A4-3B88-40D4-99CE-00C39D3623CA}{D43A9D10-FFF9-452F-BC09-849A16EBE561}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    dlg_ui.Show
-    Worksheets(REGS_SHEET).Calculate
-    
-    If dlg_ui.Tag = vbOK Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "password"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(REP_QTR_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & .risk_percent & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & .risk_percent & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .DisplayStatusBar = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{31BE411B-9A39-4A9B-93B3-C48ACAE40B79}{0B852A5A-39E9-473F-9770-DE07CFE39BD4}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{D6C6CCC9-854A-4057-8497-6C22D855BE98}{FDC1AE45-9B6A-4E36-AAAC-B49F2C9BC02A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{4E5D8609-88BF-46DB-AB10-7145E0443E10}{F7BD7335-6A91-4F24-985A-8DA608EB2F99}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{DB3353AA-A70C-4D14-962B-2BA0A3F0D97E}{499AB7ED-5BBB-4B89-87DB-F4B59D96D9A5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rm_files() As String, fm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data fm_file
-    
-    For i = 1 To UBound(rm_files)
-        
-        Dim rm_file As String
-        'setup input and output files
-        rm_file = rm_files(i)
-        
-        Dim new_rm_id As Long
-        ' insert MR data and get new rm_id
-        new_rm_id = MergeRM(rm_file, fm_file)
-        
-        '''''
-        ''' Foeach rep_id in getAllREPFromFile
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file, new_rm_id)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-Sub test_import()
-    Dim MyPath As String
-    Dim flist() As String
-    Dim i As Integer
-    MyPath = "g:\"
-    i = GetDBList(MyPath, flist)
-    If i > 0 Then
-        MergeGlobal flist, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-    End If
-End Sub
-<<<<<<
-======================
-dbxyz_test
->>>>>>
-Attribute VB_Name = "dbxyz_test"
-Option Explicit
-
-Sub mrg_main()
-    Dim rep_files(1 To 2) As String
-    Dim rm_file As String
-    
-    'setup input and output files
-    rep_files(1) = "e:\work\aventis\clexane-mr1.mdb"
-    rep_files(2) = "e:\work\aventis\clexane-mr2.mdb"
-    
-    'setup output file
-    rm_file = "e:\work\aventis\clexane-rm.mdb"
-    
-    MergeGlobal rep_files, rm_file
-End Sub
-
-Sub ttt()
-    Dim rcd() As tREPID_COMMON
-    Dim i As Long
-    i = Get_REP_CommonList_by_QTR(rcd, "2003-III")
-End Sub
-
-Sub getallreps()
-    Dim i As Integer
-    Dim j As Integer
-    Dim k As Integer
-    Dim s As String
-    
-    Dim allREPID() As tREPID
-    Dim allQTRREP() As tQTR
-    Dim allLPU() As tLPU
-    
-    i = GetAll_REPID_Records(allREPID)
-    
-    If i > 0 Then
-        For i = 1 To UBound(allREPID)
-            j = GetAll_QTR_Records_by_REP(allQTRREP, "%", allREPID(i).rep_id)
-            If j > 0 Then
-                For j = 1 To UBound(allREPID)
-                    k = GetAll_LPU_byQTR(allLPU, allQTRREP(j).entry_date, allREPID(i).rep_id)
-                    If k > 0 Then
-                        For k = 1 To UBound(allLPU)
-                            MsgBox allLPU(k).name
-                        Next k
-                    End If
-                Next j
-            End If
-        Next i
-    End If
-End Sub
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-        End If
-    Next i
-
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            def_dir = GetWBPath(ThisWorkbook.FullName)
-            If GetImportDirectory(def_dir, flist) Then
-                Dim db_list() As String
-                i = GetDBList(flist(0), db_list)
-                If i > 0 Then
-                    MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-                End If
-            End If
-            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_ALLOWMULTISELECT + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-mImport2
->>>>>>
-Attribute VB_Name = "mImport2"
-Option Explicit
-
-Sub FOpen()
-    Dim flist As String
-    Dim fileToOpen, s
-    flist = ""
-    fileToOpen = Application _
-        .GetOpenFileName("Data Files (*.mdb), mr*.mdb", title:="������ ������", MultiSelect:=True)
-    If fileToOpen <> False Then
-        For Each s In fileToOpen
-            flist = flist & s & "; "
-        Next s
-        MsgBox "Open " & flist
-    End If
-End Sub
-
-Sub t2()
-    Dim d As dlgImprtDB
-    Set d = New dlgImprtDB
-    d.Show
-End Sub
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{D75A4C48-C417-4050-8B59-6ADE57EB3F46}{A7D47189-76ED-4894-92BF-5E93B11D524E}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Unprotect "password"
-    ThisWorkbook.Save
-End Sub
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Protect password:="password"
-    Worksheets("Calc").Protect password:="password", userInterfaceonly:=True
-    Worksheets("Calc").Select
-    Worksheets("Calc").Range("A7").Select
-End Sub
-<<<<<<
-======================
-Calc
->>>>>>
-Attribute VB_Name = "Calc"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Sub SelectAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOn
-        End If
-    Next Sh
-    Range("A7").Select
-End Sub
-
-Sub ClearAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOff
-        End If
-    Next Sh
-    Range("A7").Select
-    Worksheets("Data").Range("K2") = 1
-    Worksheets("Calc").Range("E58") = 1
-End Sub
-
-<<<<<<
-======================
-Data
->>>>>>
-Attribute VB_Name = "Data"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'Telfast_marketing'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    Dim res
-    res = MsgBox( _
-        prompt:="�� ������� ��������� ���������? �� ������ ��?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If res <> vbYes Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    
-    Dim NewFileName, DefFileName, WBPath As String
-    NewFileName = MakeNewFileName( _
-                        Worksheets("home").Range("USER_NAME_F"), _
-                        Worksheets("home").Range("USER_NAME_S"), _
-                        Worksheets("data").Range("CITY_TABLES") _
-                        .Offset( _
-                            Worksheets("data").Range("IDX_CITY"), _
-                            (Worksheets("data").Range("IDX_REGION") - 1) * 2 _
-                        ) _
-                    )
-    DefFileName = MakeNewFileName( _
-                        DEF_USER_NAME_F, _
-                        DEF_USER_NAME_S, _
-                        Worksheets("data").Range("CITY_TABLES") _
-                        .Offset(DEF_IDX_CITY, (DEF_IDX_REGION - 1) * 2) _
-                    )
-    WBPath = GetWBPath(ThisWorkbook.FullName)
-    
-    If ThisWorkbook.Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            If NewFileName <> DefFileName Then
-                dlgFname.Caption = PROGRAM_NAME
-                dlgFname.lbFName = NewFileName
-                dlgFname.lbFPath = WBPath
-                dlgFname.Show
-                NewFileName = WBPath & NewFileName
-                ThisWorkbook.SaveAs FileName:=NewFileName
-            Else
-                ThisWorkbook.Save
-            End If
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(HOME_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 1
-    Case INP_TXT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-
-    If is_InputRange(Target) <> INP_NO Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    Dim test As Boolean
-    
-    is_InputRange = INP_NO
-    
-    If r.Column = Range("USER_NAME_F").Column Then
-        test = r.Row = Range("USER_NAME_S").Row _
-                        Or r.Row = Range("USER_NAME_F").Row
-        If test Then
-            is_InputRange = INP_TXT
-        End If
-    Else
-        If r.Column = Range("USER_PLAN").Column Then
-            test = r.Row = Range("USER_PLAN").Row _
-                            Or r.Row = Range("USER_FACT").Row _
-                            Or r.Row = Range("USER_BUDGET").Row _
-                            Or r.Row = Range("USER_SVNORM").Row
-            
-            Dim idx As Integer
-            idx = Worksheets(DATA_SHEET).Range("IDX_PERSONE")
-            
-            If test Then
-                is_InputRange = INP_NUM
-            Else
-                If r.Row = Range("USER_STAF").Row Then
-                    If idx = 1 Then
-                        is_InputRange = INP_NUM
-                    End If
-                End If
-            End If
-        End If
-    End If
-End Function
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC As String = "C9"
-Const INP_APT As String = "C11"
-Const INP_ADV As String = "C13"
-Const INP_ACT As String = "C15"
-Const INP_VIP As String = "C17"
-Const INP_SUM As String = "C19"
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    
-    If is_InputRange(Target) Then
-        GoalSeekNow Range(INP_SUM), Target
-    Else
-        If Target.Row = Range(INP_SUM).Row And Target.Column = Range(INP_SUM).Column Then
-            Dim Addr As String
-            
-            Addr = INP_DOC & "," & INP_APT & "," & INP_ADV & "," & INP_ACT & "," & INP_VIP
-            RangeNormalize Range(Addr), Target
-            
-        End If
-    End If
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.2
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range(INP_DOC).Column _
-                And ( _
-                    r.Row = Range(INP_DOC).Row _
-                    Or r.Row = Range(INP_APT).Row _
-                    Or r.Row = Range(INP_ADV).Row _
-                    Or r.Row = Range(INP_ACT).Row _
-                    Or r.Row = Range(INP_VIP).Row _
-                )
-End Function
-
-
-<<<<<<
-======================
-mHome
->>>>>>
-Attribute VB_Name = "mHome"
-Option Explicit
-
-Sub cboxPersone_Change()
-    With ThisWorkbook.Worksheets(HOME_SHEET)
-        Dim r As Range
-        Range("A1").Select
-        If .Shapes("cboxPersone").ControlFormat.ListIndex = 2 Then
-            .Unprotect
-            .Range("G15") = 1
-            If Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-                .Protect
-            End If
-        End If
-    End With
-End Sub
-
-Sub cboxArea_Change()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    With ThisWorkbook.Worksheets(DATA_SHEET)
-        GroupIdx = .Range("IDX_REGION")
-        .Range("IDX_CITY") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        NewSumRange = .Name & "!" & .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).Address
-    End With
-    With ThisWorkbook.Worksheets(HOME_SHEET)
-        .Shapes("cboxCity").ControlFormat.ListFillRange = NewCbxRange
-        .Unprotect
-        .Range("G10").Formula = "=sum(" & NewSumRange & ")"
-        If Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-            .Protect
-        End If
-    End With
-End Sub
-
-Sub cboxCity_Change()
-    
-End Sub
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-
-Sub btHome_Click()
-    Worksheets(HOME_SHEET).Select
-    Worksheets(DATA_SHEET).Range("CUR_STATE") = 0
-End Sub
-
-Sub bt2Budget_Click()
-    Sheets("budget").Select
-End Sub
-
-
-Sub btBdgtPrev_Click()
-    btHome_Click
-End Sub
-
-Sub btBdgtNext_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Final").Select
-    End If
-End Sub
-
-Sub btDoc_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Doc").Select
-    End If
-End Sub
-
-Sub btDocVisit_Click()
-    Sheets("Doc.Visit").Select
-End Sub
-
-Sub btDocConf_Click()
-    Sheets("Doc.Conf").Select
-End Sub
-
-Sub btApt_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Apt").Select
-    End If
-End Sub
-
-Sub btAptVisit_Click()
-    Sheets("Apt.Visit").Select
-End Sub
-
-
-Sub btAptConf_Click()
-    Sheets("Apt.Conf").Select
-End Sub
-
-Sub btAdv_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Adv").Select
-    End If
-End Sub
-
-Sub btAdvPrev_Click()
-    If check_Adv Then
-        bt2Budget_Click
-    End If
-End Sub
-
-Sub btAct_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Act").Select
-    End If
-End Sub
-
-Sub btCost_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Cost").Select
-    End If
-End Sub
-
-Sub btCostPrev_Click()
-    If check_budget(Range("Cost!C17")) Then
-        Sheets("budget").Select
-    End If
-End Sub
-
-<<<<<<
-======================
-Sheet40
->>>>>>
-Attribute VB_Name = "Sheet40"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.7
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range("C9").Column _
-                    And r.Row = Range("C9").Row
-End Function
-
-
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub test()
-    Dim str As String
-    str = GetWBPath(ThisWorkbook.FullName)
-End Sub
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-Attribute SetDesignFlagOn.VB_ProcData.VB_Invoke_Func = "E\n14"
-    Dim Sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each Sh In Worksheets
-        Sh.Unprotect
-        Sh.Visible = xlSheetVisible
-    Next Sh
-    Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-Attribute SetDesignFlagOff.VB_ProcData.VB_Invoke_Func = " \n14"
-    Application.ScreenUpdating = False
-    Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim Sh As Worksheet
-    For Each Sh In Worksheets
-        If Sh.Name <> "data" Then
-            Sh.Protect
-        Else
-            Sh.Visible = xlSheetVeryHidden
-        End If
-    Next Sh
-    Application.ScreenUpdating = True
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma training"
-Public Const PROGRAM_VERSION As String = "version 1.0"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "N35"
-Public Const CITY_TABLES As String = "N30"
-
-
-Public Const DATA_SHEET As String = "data"
-
-' �������� ����� Home
-Public Const DEF_USER_NAME_F As String = "����"
-Public Const DEF_USER_NAME_S As String = "��������"
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Public Const HOME_SHEET As String = "Home"
-Public Const USER_NAME_F As String = "USER_NAME_F"
-Public Const USER_NAME_S As String = "USER_NAME_S"
-Public Const USER_PLAN As String = "USER_PLAN"
-Public Const USER_BUDGET As String = "USER_BUDGET"
-Public Const USER_FACT As String = "USER_FACT"
-
-' �������� ����� Adv
-Public Const ADV_SHEET As String = "Adv"
-Public Const ADV_SUM_CAP As String = "K9"
-Public Const ADV_SUM_DOC As String = "C17"
-Public Const ADV_SUM_APT As String = "E17"
-Public Const ADV_SUM_CAST As String = "G17"
-Public Const ADV_SUM_DIST As String = "I17"
-
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{86C0099E-D971-435A-9BDD-7CCC071221F4}{B8D80B60-74EE-4C27-8096-D633BF258DBA}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{F27A11EC-D74B-47FE-AFE4-0699ED6724FD}{C40F68B8-2231-4C63-A120-5ADA5A70DE13}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-Sheet52
->>>>>>
-Attribute VB_Name = "Sheet52"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTDATE_LT As String = "B11"
-Const INPUTDATE_RB As String = "B25"
-Const INPUTTEXT_LT As String = "C11"
-Const INPUTTEXT_RB As String = "C25"
-Const INPUTNUMB_LT As String = "F11"
-Const INPUTNUMB_RB As String = "I25"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("B11").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTDATE_LT), Range(INPUTDATE_RB)) Then
-        is_InputRange = INP_DAT
-    Else
-        If is_InputArea(r, Range(INPUTTEXT_LT), Range(INPUTTEXT_RB)) Then
-            is_InputRange = INP_TXT
-        Else
-            If is_InputArea(r, Range(INPUTNUMB_LT), Range(INPUTNUMB_RB)) Then
-                    is_InputRange = INP_NUM
-            Else
-                is_InputRange = INP_NO
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Function check_Adv() As Boolean
-    Dim b As Boolean
-    b = Abs(Range(ADV_SUM_CAP) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_DOC) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_APT) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_CAST) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_DIST) - 1) < 0.0001 _
-        Or Range("D13") = 0
-    If Not b Then
-        MsgBox "�� ��������� ��������� ������. �������� ����� ������ ���� = 100%"
-    End If
-    check_Adv = b
-End Function
-
-Function check_budget(r As Range) As Boolean
-    Dim f As Double
-    Dim b As Boolean
-    f = r
-    b = Abs(f - 1#) < 0.0001
-    If Not b Then
-        MsgBox "�� ��������� ��������� ������. �������� ����� ������ ���� = 100%"
-    End If
-    check_budget = b
-End Function
-
-Sub RangeNormalize(Src As Range, Dst As Range)
-    Dim f As Double
-    Dim c As Range
-    f = Dst
-    If f <> 0 Then
-        Src.Worksheet.Unprotect
-        For Each c In Src
-            c = c / f
-        Next c
-        If Not Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-            Src.Worksheet.Protect
-        End If
-    Else
-        MsgBox "������� ���� �� ���� �����!"
-    End If
-End Sub
-
-Sub GoalSeekNow(Goal As Range, Target As Range)
-    Dim diff As Double
-    
-    diff = Goal - 1
-    If Abs(diff) > 0.0001 Then
-        If (diff > 0 And diff < Target) Or (diff < 0 And 1 - Target > Abs(diff)) Then
-            Goal.GoalSeek Goal:=1, ChangingCell:=Range(Target.Address)
-        Else
-            MsgBox "���������� �������� �� ��������. �������� ������ ��������!"
-        End If
-    End If
-
-End Sub
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100."
-    End If
-End Sub
-
-Sub Check_Number(Target As Range, Def_Val As Double)
-    Dim test As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                test = True
-            End If
-        End If
-    Next r
-    
-    If test Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!"
-    End If
-    
-End Sub
-
-Function is_InputArea(r As Range, LT As Range, RB As Range) As Boolean
-    is_InputArea = r.Column >= LT.Column _
-                And r.Row >= LT.Row _
-                And r.Column <= RB.Column _
-                And r.Row <= RB.Row
-End Function
-
-<<<<<<
-======================
-Sheet70
->>>>>>
-Attribute VB_Name = "Sheet70"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_NUM_1_LT As String = "E14"
-Const INP_NUM_1_RB As String = "J14"
-Const INP_NUM_2_LT As String = "E16"
-Const INP_NUM_2_RB As String = "J16"
-Const INP_NUM_3_LT As String = "E18"
-Const INP_NUM_3_RB As String = "J18"
-Const INP_NUM_4_LT As String = "E20"
-Const INP_NUM_4_RB As String = "J20"
-Const INP_NUM_5_LT As String = "E22"
-Const INP_NUM_5_RB As String = "J22"
-
-Const INP_DAT_1_LT As String = "B14"
-Const INP_DAT_1_RB As String = "C14"
-Const INP_DAT_2_LT As String = "B16"
-Const INP_DAT_2_RB As String = "C16"
-Const INP_DAT_3_LT As String = "B18"
-Const INP_DAT_3_RB As String = "C18"
-Const INP_DAT_4_LT As String = "B20"
-Const INP_DAT_4_RB As String = "C20"
-Const INP_DAT_5_LT As String = "B22"
-Const INP_DAT_5_RB As String = "C22"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("B14").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) <> INP_NO Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Integer
-    Dim test As Boolean
-    
-    test = is_InputArea(r, Range(INP_NUM_1_LT), Range(INP_NUM_1_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_2_LT), Range(INP_NUM_2_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_3_LT), Range(INP_NUM_3_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_4_LT), Range(INP_NUM_4_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_5_LT), Range(INP_NUM_5_RB))
-    If test Then
-       is_InputRange = INP_NUM
-    Else
-        test = is_InputArea(r, Range(INP_DAT_1_LT), Range(INP_DAT_1_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_2_LT), Range(INP_DAT_2_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_3_LT), Range(INP_DAT_3_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_4_LT), Range(INP_DAT_4_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_5_LT), Range(INP_DAT_5_RB))
-        If test Then
-            is_InputRange = INP_DAT
-        Else
-            is_InputRange = INP_NO
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-Sheet30
->>>>>>
-Attribute VB_Name = "Sheet30"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet41
->>>>>>
-Attribute VB_Name = "Sheet41"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const MEMBERSHIP As String = "D7"
-Const MILEAGE As String = "D9"
-Const INPUTAREA_LT As String = "C17"
-Const INPUTAREA_RB As String = "E24"
-
-Const ChangeCheckFlag As Boolean = False
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C17").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-        Case 1
-            Check_Number Target, 1
-        Case 2
-            Check_Number Target, 15
-        Case 3
-            Check_Number Target, 50
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If r.Column = Range(MEMBERSHIP).Column And r.Row = Range(MEMBERSHIP).Row Then
-        is_InputRange = 1
-    Else
-        If r.Column = Range(MILEAGE).Column And r.Row = Range(MILEAGE).Row Then
-            is_InputRange = 2
-        Else
-            If r.Column >= Range(INPUTAREA_LT).Column _
-                And r.Row >= Range(INPUTAREA_LT).Row _
-                And r.Column <= Range(INPUTAREA_RB).Column _
-                And r.Row <= Range(INPUTAREA_RB).Row Then
-                    is_InputRange = 3
-            Else
-                is_InputRange = 0
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet42
->>>>>>
-Attribute VB_Name = "Sheet42"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTDATE_LT As String = "B11"
-Const INPUTDATE_RB As String = "B25"
-Const INPUTTEXT_LT As String = "C11"
-Const INPUTTEXT_RB As String = "C25"
-Const INPUTNUMB_LT As String = "F11"
-Const INPUTNUMB_RB As String = "I25"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range(INPUTDATE_LT).Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTDATE_LT), Range(INPUTDATE_RB)) Then
-        is_InputRange = INP_DAT
-    Else
-        If is_InputArea(r, Range(INPUTTEXT_LT), Range(INPUTTEXT_RB)) Then
-            is_InputRange = INP_TXT
-        Else
-            If is_InputArea(r, Range(INPUTNUMB_LT), Range(INPUTNUMB_RB)) Then
-                    is_InputRange = INP_NUM
-            Else
-                is_InputRange = INP_NO
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet60
->>>>>>
-Attribute VB_Name = "Sheet60"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC_LT As String = "C10"
-Const INP_DOC_RB As String = "C16"
-Const INP_APT_LT As String = "E10"
-Const INP_APT_RB As String = "E16"
-Const INP_CAST_LT As String = "G10"
-Const INP_CAST_RB As String = "G16"
-Const INP_DIST_LT As String = "I10"
-Const INP_DIST_RB As String = "I16"
-Const CAP_DOC As String = "C9"
-Const CAP_APT As String = "E9"
-Const CAP_CAST As String = "G9"
-Const CAP_DIST As String = "I9"
-
-
-Const INP_NO As Integer = 0
-Const INP_CAP As Integer = 1
-Const INP_DOC As Integer = 2
-Const INP_APT As Integer = 3
-Const INP_CAST As Integer = 4
-Const INP_DIST As Integer = 5
-
-Const INP_SUM_CAP As Integer = 11
-Const INP_SUM_DOC As Integer = 12
-Const INP_SUM_APT As Integer = 13
-Const INP_SUM_CAST As Integer = 14
-Const INP_SUM_DIST As Integer = 15
-
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim Inp As Integer
-    Dim Addr As String
-    Inp = is_InputRange(Target)
-    Select Case is_InputRange(Target)
-        Case INP_NO
-            Cancel = False
-        
-        Case INP_CAP
-            GoalSeekNow Range(ADV_SUM_CAP), Target
-        
-        Case INP_DOC
-            GoalSeekNow Range(ADV_SUM_DOC), Target
-        
-        Case INP_APT
-            GoalSeekNow Range(ADV_SUM_APT), Target
-        
-        Case INP_CAST
-            GoalSeekNow Range(ADV_SUM_CAST), Target
-        
-        Case INP_DIST
-            GoalSeekNow Range(ADV_SUM_DIST), Target
-        
-        Case INP_SUM_CAP
-            Addr = CAP_DOC & "," & CAP_APT & "," & CAP_CAST & "," & CAP_DIST
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_DOC
-            Addr = INP_DOC_LT & ":" & INP_DOC_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_APT
-            Addr = INP_APT_LT & ":" & INP_APT_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_CAST
-            Addr = INP_CAST_LT & ":" & INP_CAST_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_DIST
-            Addr = INP_DIST_LT & ":" & INP_DIST_RB
-            RangeNormalize Range(Addr), Target
-    End Select
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_CAP
-        Check_Percent Target, 0.25
-    Case INP_DOC, INP_APT, INP_CAST, INP_DIST
-        Check_Percent Target, 0.15
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) > 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Integer
-    is_InputRange = INP_NO
-    If r.Row = Range(CAP_DOC).Row Then
-        If r.Column = Range(CAP_DOC).Column _
-                Or r.Column = Range(CAP_APT).Column _
-                Or r.Column = Range(CAP_CAST).Column _
-                Or r.Column = Range(CAP_DIST).Column Then
-            is_InputRange = INP_CAP
-        End If
-        If r.Column = Range(ADV_SUM_CAP).Column Then
-            is_InputRange = INP_SUM_CAP
-        End If
-    Else
-        If is_InputArea(r, Range(INP_DOC_LT), Range(INP_DOC_RB)) Then
-            is_InputRange = INP_DOC
-        Else
-            If is_InputArea(r, Range(INP_APT_LT), Range(INP_APT_RB)) Then
-                is_InputRange = INP_APT
-            Else
-                If is_InputArea(r, Range(INP_CAST_LT), Range(INP_CAST_RB)) Then
-                    is_InputRange = INP_CAST
-                Else
-                    If is_InputArea(r, Range(INP_DIST_LT), Range(INP_DIST_RB)) Then
-                        is_InputRange = INP_DIST
-                    Else
-                        If r.Row = Range(ADV_SUM_DOC).Row Then
-                            If r.Column = Range(ADV_SUM_DOC).Column Then
-                                is_InputRange = INP_SUM_DOC
-                            End If
-                            If r.Column = Range(ADV_SUM_APT).Column Then
-                                is_InputRange = INP_SUM_APT
-                            End If
-                            If r.Column = Range(ADV_SUM_APT).Column Then
-                                is_InputRange = INP_SUM_APT
-                            End If
-                            If r.Column = Range(ADV_SUM_CAST).Column Then
-                                is_InputRange = INP_SUM_CAST
-                            End If
-                            If r.Column = Range(ADV_SUM_DIST).Column Then
-                                is_InputRange = INP_SUM_DIST
-                            End If
-                        End If
-                    End If
-                End If
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet50
->>>>>>
-Attribute VB_Name = "Sheet50"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.7
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range("C9").Column _
-                    And r.Row = Range("C9").Row
-End Function
-
-
-<<<<<<
-======================
-Sheet51
->>>>>>
-Attribute VB_Name = "Sheet51"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTAREA_LT As String = "C17"
-Const INPUTAREA_RB As String = "E20"
-
-Const ChangeCheckFlag As Boolean = False
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C17").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) <> 0 Then
-        Check_Number Target, 50
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTAREA_LT), Range(INPUTAREA_RB)) Then
-        is_InputRange = 3
-    Else
-        is_InputRange = 0
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet80
->>>>>>
-Attribute VB_Name = "Sheet80"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC As String = "C9"
-Const INP_APT As String = "C11"
-Const INP_CUST As String = "C13"
-Const INP_DIST As String = "C15"
-Const INP_SUM As String = "C17"
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    
-    If is_InputRange(Target) Then
-        GoalSeekNow Range(INP_SUM), Target
-    Else
-        If Target.Row = Range(INP_SUM).Row And Target.Column = Range(INP_SUM).Column Then
-            Dim Addr As String
-            
-            Addr = INP_DOC & "," & INP_APT & "," & INP_CUST & "," & INP_DIST
-            RangeNormalize Range(Addr), Target
-            
-        End If
-    End If
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.25
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range(INP_DOC).Column _
-                And ( _
-                    r.Row = Range(INP_DOC).Row _
-                    Or r.Row = Range(INP_APT).Row _
-                    Or r.Row = Range(INP_CUST).Row _
-                    Or r.Row = Range(INP_DIST).Row _
-                )
-End Function
-
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-'                With .Controls
-'                    With .Add(msoControlButton)
-'                        .Caption = "&Contents"
-'                        .Style = msoButtonIconAndCaption
-'                        .FaceId = 49
-'                        .OnAction = "cmHelpContents"
-'                    End With
-'                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Telfast.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-    ThisWorkbook.Worksheets("home").Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-    Else
-        cmSetStandaloneMode
-    End If
-    ThisWorkbook.Worksheets("home").Select
-End Sub
-
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.Count > 1 Then
-        wbname = Wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            Wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Telfast bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(HOME_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(HOME_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{C49C37AF-FB78-4D39-BE95-F98ECF8A9575}{0C81C15B-882C-4E57-B743-863D7DCE2CE5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    
-    dlgPrint.cbMainReport = True
-    dlgPrint.cbMainBudget = False
-    dlgPrint.cbSrcData = False
-    dlgPrint.cbAllSheets = False
-    
-    dlgPrint.Show
-    
-    If dlgPrint.Tag = vbCancel Then
-        Exit Sub
-    End If
-    
-    Dim PrnIdx As Integer
-    
-    With dlgPrint
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("home", "budget", "Final")
-    Case 1111
-        plist = Array("home", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("home")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-dlgFname
->>>>>>
-Attribute VB_Name = "dlgFname"
-Attribute VB_Base = "0{05AF5AE8-7423-4FD0-B32C-74A4E8EE39E2}{DDEF6ED6-73A3-4D13-AD90-B90001E9E37F}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btOK_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Macro1()
-Attribute Macro1.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro1.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro1 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    Charts.Add
-    ActiveChart.ChartType = xlBubble
-    ActiveChart.SetSourceData Source:=Sheets("file1").Range("H2:J11"), PlotBy:= _
-        xlColumns
-    ActiveChart.Location Where:=xlLocationAsObject, Name:="file1"
-    With ActiveChart
-        .HasTitle = True
-        .ChartTitle.Characters.Text = "�������"
-        .Axes(xlCategory, xlPrimary).HasTitle = True
-        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "���� ��������"
-        .Axes(xlValue, xlPrimary).HasTitle = True
-        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "���������� �������"
-    End With
-    With ActiveChart.Axes(xlCategory)
-        .HasMajorGridlines = True
-        .HasMinorGridlines = False
-    End With
-    With ActiveChart.Axes(xlValue)
-        .HasMajorGridlines = True
-        .HasMinorGridlines = False
-    End With
-    ActiveChart.HasLegend = False
-    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
-    ActiveChart.SeriesCollection(1).Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(9).DataLabel.Select
-    Selection.Characters.Text = "8379 �1"
-    Selection.AutoScaleFont = False
-    With Selection.Characters(Start:=1, Length:=7).Font
-        .Name = "Arial"
-        .FontStyle = "�������"
-        .Size = 10
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveChart.Axes(xlValue).MajorGridlines.Select
-End Sub
-Sub Macro2()
-Attribute Macro2.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro2.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro2 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    Application.CutCopyMode = False
-    With ActiveChart.ChartGroups(1)
-        .VaryByCategories = True
-        .ShowNegativeBubbles = False
-        .SizeRepresents = xlSizeIsArea
-        .BubbleScale = 100
-    End With
-End Sub
-Sub Macro3()
-Attribute Macro3.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro3.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro3 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(6).DataLabel.Select
-    ActiveChart.Axes(xlValue).MajorGridlines.Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(6).DataLabel.Select
-    Selection.Characters.Text = "9847 �2"
-    Selection.AutoScaleFont = False
-    With Selection.Characters(Start:=1, Length:=7).Font
-        .Name = "Arial"
-        .FontStyle = "�������"
-        .Size = 12
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveChart.PlotArea.Select
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'ClexaneRM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).ClearRMName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "version 1.3"
-Public Const PROGRAM_FILENAME As String = "clexane-rm"
-Public Const PROGRAM_BACKUPNAME As String = "rm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "rm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "mr-ex-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{F2A5159C-AEB6-4066-B85F-339184DAFECD}{712D78F6-CCB6-499E-9674-B992A7482317}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{5D2CB2D2-3E5E-4B6E-9E0C-2EEBA5E10E17}{C891C133-B6B4-43D3-B411-B4A821905C23}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Boolean
-        Dim sum As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BB60E38F-A4AB-4AB4-91D0-40AA798D9F5C}{BE9A54D9-F093-4755-9E17-0B47BB5E2546}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{2C69E842-8DA9-4240-A0A8-F6B0141DC246}{75AAB28C-ADCF-4D1B-9D5A-AF89E80A810C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{BA873669-5C2D-400A-8A8B-572ACD8CCE4C}{D11400A0-9912-4240-A78C-44C33731216A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSet_REGMAN_Record
-    With Worksheets("RM_QTR")
-        .ClearRMName
-        .Range("REP_QTR_INPUT_DATA").ClearContents ' ��� �� ������, �������� ���������
-'        .Range("A1").Select
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-    
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-
-
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Sub ReSetREPRecord()
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbReSetREPRecord dbConnection
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-'Public Sub dbReSetREPRecord(dbConnection As Object)
-'
-'    Dim DeleteSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-       End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmImport()
-    Worksheets(RM_QTR_SHEET).Select
-    ImportData
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("RM_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    End If
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{3EA3C15A-5493-445F-9858-2F241E7D6CEA}{849C1FE1-631A-485D-BE54-A7B73124582C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{B85FF7F1-50C0-4433-BC6F-8A0F2C9BDDDA}{EC2D2B9E-9ED2-4005-A1E9-EF0626D3B7E7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    
-    Unprotect
-    
-    On Error Resume Next
-    
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{EC96F2D1-337D-47DF-B0F1-A6DF3F8CD5CC}{7EB42A63-CBFC-45B0-AE4D-C3E3D8FE7420}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{7B669454-C2AA-4FDF-8311-7ADEDDEF3FF3}{D07A0A02-4923-46C8-8EE8-62769243087D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetLastQTR_fromDB & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRMName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-End Sub
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSet_REGMAN_Record()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSet_REGMAN_Record dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-Public Sub dbReSet_REGMAN_Record(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-End Sub
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� �������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{D5892870-2C88-40C8-A817-AC9B1CF37C2C}{9853EBEA-4E48-41F9-89C0-6F753EB6A0C2}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            ImportData
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub ImportData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        If i > 0 Then
-            Merge_BackUp_All_Data
-            MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-        End If
-    End If
-    Worksheets(RM_QTR_SHEET).update_history
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-Project Name : 'ClexanePM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    Application.ScreenUpdating = True
-'    CheckUser
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).update_history
-    Application.Calculate
-
-End Sub
-
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "QTR_SEL"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Worksheets(REP_QTR_SHEET).Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .setEnt_date (ent_date)
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).getEnt_date()
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public ppReport As New cPPReport
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[PM]"
-Public Const PROGRAM_VERSION As String = "Clexane[PM] ver 1.1"
-Public Const PROGRAM_FILENAME As String = "clexane-pm"
-Public Const PROGRAM_BACKUPNAME As String = "pm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "pm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "rm-ex*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-Public Const CHART_DEF_TITLE As String = "* * *"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20031207
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O41"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-Public Const PRJ_QTR_SHEET As String = "PRJ_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Function time_correct(end_date As Long, ByVal theDate As Date) As Boolean
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-    If end_date = NO_ESTIMATION_DATE Then
-        time_correct = True
-        Exit Function
-    End If
-    
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    
-    time_correct = CurDate <= end_date
-    
-End Function
-
-Sub EnableRun(end_date As Long)
-    If Not time_correct(end_date, Now) Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub t()
-    EnableRun ESTIMATION_DATE
-End Sub
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Sub OpenPPT()
-    ppReport.ReportView
-End Sub
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    SelectLPU_BDGT lpu_id, ent_date
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .setEnt_date (ent_date)
-            .Range("lpu_id") = lpu_id
-            .Range("REP_ID") = rep_id
-            .Range("RM_ID") = rm_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("RM_ID") = rm_id
-        .Range("REP_ID") = rep_id
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.Name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{32FB0F3D-6884-41DC-99DB-E2C55B2257C4}{DED79A66-DA60-4CCC-9003-082480235D55}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{0DC9E035-CE0A-49FF-85A2-A4EC5FF8FE96}{D54DDC8A-1EE2-4BB3-8B94-343B521AF098}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S15"
-
-Sub PrintCopy()
-    Range("B1:K21").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), Range("RM_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    objLPU = Get_LPU_Record(id, Range("RM_ID"))
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.Name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BFB4547C-96A7-4739-AA0A-CEF1E35E2BDC}{C3D618A3-9410-4BC7-9D93-3B049D361132}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.Name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-    sh.Range("ret_addr") = ""
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{9AAD262F-A6C4-4912-9C58-D7A2071181B8}{9470F4EB-DA9F-4584-9159-D09319548D21}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{A8FBEE9C-DE59-49DE-971D-07BC9C0E9BD2}{C712732B-D8E4-4C2D-8E78-AC90968E0CD7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hw_reset()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        MsgBox "2"
-        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-'    Dim cREGMAN As tREGMAN
-'    Dim idx As Integer
-'    Dim dlg_ui As UserInfo
-'
-'    Set dlg_ui = New UserInfo
-'
-'    cREGMAN = Get_REGMAN_Record()
-'
-'    With ThisWorkbook.Worksheets(REGS_SHEET)
-'        .Range("IDX_REGION") = cREGMAN.Region
-'        .Range("IDX_CITY") = cREGMAN.City
-'    End With
-'
-'    With dlg_ui
-'        .cbRegion = cREGMAN.Region
-'        .cbCity = cREGMAN.City
-'        .tbFName = cREGMAN.FirstName
-'        .tbLName = cREGMAN.LastName
-'    End With
-'
-'    dlg_ui.Show
-'    Worksheets(REGS_SHEET).Calculate
-'
-'    If dlg_ui.Tag = vbOK Then
-'        With cREGMAN
-'            .Region = dlg_ui.cbRegion.Value
-'            .City = dlg_ui.cbCity.Value
-'            .FirstName = dlg_ui.tbFName.Value
-'            .LastName = dlg_ui.tbLName.Value
-'        End With
-'        Set_REGMAN_Record cREGMAN
-'    Else
-'        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-'    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    rm_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String, rm_id As Long) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String, rm_id As Long) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .rm_id = rm_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    rm_id As Long
-    Name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long, rm_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long, rm_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.Name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.Name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.rm_id = dbRecordset("rm_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id " & _
-    "AND lpu.rep_id=" & rep_id & " AND lpu.rm_id=lpu_budget.rm_id AND lpu.rm_id=" & rm_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds, lpu.rm_id AS rm_id " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .Name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cdbRM
->>>>>>
-Attribute VB_Name = "cdbRM"
-Option Explicit
-
-Public Type tRMID_COMMON
-    rm As tREGMAN
-    rgcd_count As Integer
-    rgcd() As tREGION
-End Type
-
-Function Get_RM_CommonList_by_QTR(ByRef rmcd() As tRMID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_RM_CommonList_by_QTR = dbGet_RM_CommonList_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_RM_CommonList_by_QTR(dbConnection As Object, ByRef rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    ' �������� ������ RM-��
-    Dim count As Integer
-    count = db_get_All_RM_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    Dim i As Integer
-    For i = 1 To count
-        rmcd(i).rgcd_count = 1
-        ReDim rmcd(i).rgcd(1 To 1)
-        getREGION_by_QTR ent_date, rmcd(i).rgcd(1), rmcd(i).rm.rm_id
-    Next i
-    dbGet_RM_CommonList_by_QTR = count
-End Function
-
-Function db_get_All_RM_by_QTR(dbConnection As Object, rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    
-    Dim count_sql As String
-    Dim get_sql As String
-    Dim rs As Object
-    Dim RM_Count As Integer
-        
-    count_sql = "SELECT COUNT(*) AS RM_TOTAL FROM reg_man"
-    get_sql = "SELECT * FROM reg_man"
-    Set rs = CreateObject("ADODB.Recordset")
-    rs.Open count_sql, dbConnection
-    
-    If Not rs.BOF Then
-        RM_Count = rs("RM_TOTAL")
-    End If
-    
-    rs.Close
-    
-     db_get_All_RM_by_QTR = RM_Count
-    
-    If RM_Count > 0 Then
-        'we have records
-        ReDim rmcd(1 To RM_Count)
-        Dim index As Long
-        index = 1
-        rs.Open get_sql, dbConnection
-        
-        If Not rs.BOF Then
-             Do While Not rs.EOF
-                 Dim tmp_rmcd As tRMID_COMMON
-                 With tmp_rmcd
-                    .rgcd_count = 0
-                    .rm.City = rs("city")
-                    .rm.FirstName = rs("firstname")
-                    .rm.LastName = rs("lastname")
-                    .rm.rm_id = rs("mgr_id")
-                    .rm.Region = rs("region")
-                 End With
-                 
-                 rmcd(index) = tmp_rmcd
-                 index = index + 1
-                 rs.MoveNext
-             Loop
-        End If
-    End If
-    
-End Function
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-           With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub CreateExtCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom extendet commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Add New Slide"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 280
-                .OnAction = "cmAddSlide"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        Application.ScreenUpdating = False
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        Application.ScreenUpdating = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmNewReport()
-    ppReport.CreateReport
-    MsgBox "����� ����� ������", vbInformation + vbOKOnly, PROGRAM_NAME
-    CreateExtCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmOpenReport()
-    Dim fileToOpen
-    Dim s As String
-    fileToOpen = Application _
-        .GetOpenFileName("Report Files (*.ppt), *.ppt", title:="Report OPen", MultiSelect:=False)
-    If fileToOpen <> False Then
-        s = fileToOpen
-        ppReport.OpenReport s
-        CreateExtCommandBar theApp:=ThisWorkbook.Application
-    End If
-End Sub
-
-Sub cmCloseReport()
-    On Error Resume Next
-    ppReport.SaveReport
-    CreateCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmAddSlide()
-    ThisWorkbook.ActiveSheet.PrintCopy
-    ppReport.InsertSlide
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("PRJ_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Unprotect
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("LPU_LIST")
-        s = .Range("C4") & " " & .Range("C3") & ", " & .Range("G4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-End Sub
-
-Sub btLPU_DEL_IT()
-'    Dim cLPU As tLPU
-'    Dim ent_date As String
-'    Dim delete_all As Integer
-'    Dim dlg_del As dlg_LPU_delete
-'
-'    With Worksheets("LPU_LIST")
-'        ent_date = .Range("ent_date")
-'        cLPU.id = .getCurrentLPU_ID()
-'    End With
-'
-'    If cLPU.id = 0 Then
-'        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-'        Exit Sub
-'    End If
-'    cLPU = Get_LPU_Record(cLPU.id)
-'
-'    Set dlg_del = New dlg_LPU_delete
-'    With dlg_del
-'        .chbDeleteQTR.Value = True
-'        .chbDeleteAll.Value = False
-'        .lComment = ent_date & ": �������� ��� '" _
-'        & cLPU.Name & "', �������������� �� ������:" _
-'        & cLPU.address & " �� ���������."
-'        .Show
-'    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    rm_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-        .rm_id = rm_id
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.rm_id = dbRecordset("rm_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id, rm_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    Dim rep_sql As String
-    Dim rm_sql As String
-    
-    rep_sql = ""
-    rm_sql = ""
-    
-    If rep_id <> 0 Then
-        rep_sql = " AND rep_id=" & rep_id
-    End If
-    
-    If rm_id <> 0 Then
-        rm_sql = " AND rm_id=" & rm_id
-    End If
-    
-    
-        getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql
-        getAll_QTR_SQL = "SELECT * FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql & " ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{92648543-CB84-4B6B-BEB3-539AE7EF9D84}{7E20E3E3-027A-483B-A14D-AA9EA5398ACC}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "��������� �����: " & Range("title")
-    Range("view_key") = False
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(%): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{067FED69-B41E-427D-AF59-5798B8E2E73A}{4C13CAB1-FDCC-4708-89EB-E92EDC125712}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id, objQTR.rm_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "���� ������: " & Range("title")
-    
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� ������: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "������� ���: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{9C81F4D2-4ECF-46F5-999B-9801D572A12F}{B382508B-7F3D-4747-8407-0F75F6F265F5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{EA8CE4CE-AC2E-45BC-BAF8-1429E6242097}{575F0762-04F4-4F86-B98A-8E87E3424B0D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(rep_id As Long, rm_id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, rep_id As Long, rm_id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT * FROM " & _
-          "rep WHERE rep_id=" & rep_id & " AND rm_id=" & rm_id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.rm_id = dbRecordset("rm_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    If rm_id <> 0 Then
-        Where = Where & " AND rep.rm_id=" & rm_id
-    End If
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record(Range("RM_ID"))
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN, Range("RM_ID"))
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record(rm_id As Long) As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSet_REGMAN_Record dbConnection, cREGMAN
-'    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object, rm_id As Long) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    objREGMAN.rm_id = rm_id
-    sql = "SELECT * FROM " & _
-          "reg_man WHERE mgr_id=" & rm_id
-          
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM reg_man"
-'    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREGMAN.FirstName & "', " & _
-'    "'" & objREGMAN.LastName & "', " & _
-'    objREGMAN.Region & ", " & _
-'    objREGMAN.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    Name As String
-End Type
-
-Public Type tDBTABLE
-    Name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).Name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).Name = "entry_date"
-    tables(1).field(2).Name = "bdgt_NMG"
-    tables(1).field(3).Name = "bdgt_NFG"
-    tables(1).field(4).Name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).Name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).Name = "entry_date"
-    tables(2).field(2).Name = "operations_per_quarter"
-    tables(2).field(3).Name = "risk_percent"
-    tables(2).field(4).Name = "patients_with_risk_ON"
-    tables(2).field(5).Name = "patients_ambulator"
-    tables(2).field(6).Name = "patients_ambulator_nmg"
-    tables(2).field(7).Name = "patients_ambulator_clexan"
-    tables(2).field(8).Name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).Name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).Name = "patients_stationar_nmg"
-    tables(2).field(11).Name = "patients_stationar_clexan"
-    tables(2).field(12).Name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).Name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).Name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).Name = "entry_date"
-    tables(3).field(2).Name = "patients_with_geparins"
-    tables(3).field(3).Name = "patients_per_quarter"
-    tables(3).field(4).Name = "patients_stationar_nmg"
-    tables(3).field(5).Name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).Name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).Name = "entry_date"
-    tables(4).field(2).Name = "patients_with_geparins"
-    tables(4).field(3).Name = "patients_per_quarter"
-    tables(4).field(4).Name = "patients_stationar_nmg"
-    tables(4).field(5).Name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).Name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).Name = "entry_date"
-    tables(5).field(2).Name = "patients_per_quarter"
-    tables(5).field(3).Name = "risk_percent"
-    tables(5).field(4).Name = "patients_with_risk_ON"
-    tables(5).field(5).Name = "patients_ambulator"
-    tables(5).field(6).Name = "patients_ambulator_nmg"
-    tables(5).field(7).Name = "patients_ambulator_clexan"
-    tables(5).field(8).Name = "patients_stationar_nmg"
-    tables(5).field(9).Name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).Name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).Name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).Name) = getRS(tables(tbl_idx).field(fld_idx).Name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 10)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    tables_to_clear(9) = "quarter_rm"
-    tables_to_clear(10) = "reg_man"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-cdbPRJ
->>>>>>
-Attribute VB_Name = "cdbPRJ"
-Option Explicit
-
-Type tPROJECT
-    total_SALE  As Long ' ����� ����� ������
-    total_BDGT  As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU   As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_RM    As Long ' ����� �����
-    total_BEDS  As Long ' ����� ����� ����
-    total_HIR   As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER   As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS   As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN   As Long '  ���� ������ ��������
-    objRGN() As tREGION
-End Type
-
-Function GetPRJ_COMM_DATA(ByRef prj_data As tPROJECT) As Integer
-    Dim i As Integer
-    i = GetRGN_COMM_DATA(prj_data.objRGN, 0)
-    GetPRJ_COMM_DATA = i
-    If i > 0 Then
-        With prj_data
-            .sale_PLAN = 0
-            .total_ACS = 0
-            .total_BDGT = 0
-            .total_BDGT_NMG = 0
-            .total_BEDS = 0
-            .total_HIR = 0
-            .total_LPU = 0
-            .total_REP = 0
-            .total_RM = 0
-            .total_SALE = 0
-            .total_TER = 0
-            For i = 1 To UBound(prj_data.objRGN)
-                
-            Next i
-        End With
-    End If
-
-End Function
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-        .setEnt_date (getEnt_date())
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("RM_ID") = rm_id
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    Dim rm_struc As tREGMAN
-    
-    i = Range("RM_ID")
-    rm_struc = Get_REGMAN_Record(i)
-    
-    Range("C4") = rm_struc.LastName
-    Range("C5") = rm_struc.FirstName
-
-    Range("G5") = GetRegionName(rm_struc.Region)
-    
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date, Range("RM_ID"))
-
-    
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_LIST")
-        s = .Range("C5") & " " & .Range("C4") & ", " & .Range("G5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("REP_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date, rm_id)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id, allREPID(i).rm_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    rm_id As Long
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION, rm_id As Long) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date, rm_id)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_REP_count As Integer
-            reg_data(i).rm_id = rm_id
-            reg_data(i).ent_date = q_date(i)
-            current_REP_count = getREGION_by_QTR(q_date(i), reg_data(i), rm_id)
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-' if rm_id = 0 then gets all records
-Function getAllQTRNames(ByRef qtr_lst() As String, rm_id As Long) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    
-    If rm_id <> 0 Then
-        sql = sql & " WHERE rm_id=" & rm_id
-    End If
-    
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION, rm_id As Long) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tQTR_COMMON
-    rep_count = Get_QTR_CommonList_by_REP(reps, ent_date, 0, rm_id)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .c_bdgt_NFG + .c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtr.sale_PLAN
-                treg.total_SALE = treg.total_SALE + .c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .c_pat_HIR
-                treg.total_TER = treg.total_TER + .c_pat_TER
-                treg.total_ACS = treg.total_ACS + .c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .i_lcd
-                treg.total_BEDS = treg.total_BEDS + .c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-'            def_dir = GetWBPath(ThisWorkbook.FullName)
-'            If GetImportDirectory(def_dir, flist) Then
-'                Dim db_list() As String
-'                i = GetDBList(flist, db_list)
-'                If i > 0 Then
-'                    ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-'                End If
-'            End If
-'            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Range("ret_addr") = "RM_QTR"
-            Worksheets("REP_LIST").setEnt_date (Worksheets(RM_QTR_SHEET).getEnt_date())
-            Worksheets("REP_LIST").Range("RM_ID") = Worksheets(RM_QTR_SHEET).Range("RM_ID")
-            Worksheets("REP_LIST").Range("VIEW_ONLY") = True
-
-            Worksheets("REP_LIST").Select
-        Case 3
-            MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub btRM_QTR_RET_IT()
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cPPReport
->>>>>>
-Attribute VB_Name = "cPPReport"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Const PPR_NON As Integer = 0
-Const PPR_NEW As Integer = 1
-Const PPR_OLD As Integer = 2
-
-Dim ReportApp As PowerPoint.Application
-Dim ReportDoc As PowerPoint.Presentation
-Dim ReportState As Integer
-Dim PowerPointPath As String
-
-Private Sub Class_Initialize()
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    PowerPointPath = ReportApp.Path & "\PowerPNT.EXE"
-    ReportState = PPR_NON
-End Sub
-
-Sub OpenReport(FileName As String)
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = GetObject(FileName)
-    ReportState = PPR_OLD
-End Sub
-
-Sub CreateReport()
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = ReportApp.Presentations.Add
-    ReportState = PPR_NEW
-End Sub
-
-Sub SaveReport()
-    Select Case ReportState
-        Case PPR_NEW
-            ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME
-        Case PPR_OLD
-            ReportDoc.Save
-    End Select
-    ReportState = PPR_NON
-End Sub
-
-Sub ReportView()
-    Dim CmdName As String
-    CmdName = GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME + ".PPT"
-    CmdName = PowerPointPath & " " & CmdName
-    Shell CmdName, 1
-End Sub
-
-Sub InsertSlide()
-    Dim ReportPage As PowerPoint.Slide
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.count + 1, ppLayoutBlank)
-    
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = "Slide #" & Format(ReportDoc.Slides.count)
-End Sub
-
-
-Private Sub Class_Terminate()
-    SaveReport
-    ReportApp.Quit
-End Sub
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{36355920-F7A4-44A8-96EF-5D79CF26137D}{F852BDF2-AB3E-468E-89DF-EC5DC0C7C88B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-rmImport
->>>>>>
-Attribute VB_Name = "rmImport"
-Option Explicit
-
-Public Type dbDESCRIPTION
-    Name As String
-    Fields() As String
-End Type
-
-Sub ImportFromRegionalManagers(rm_files() As String, fm_file As String)
-    Dim db(9) As dbDESCRIPTION
-    
-    '''''data
-    db(1).Name = "rep"
-    
-    db(2).Name = "lpu"
-    db(3).Name = "lpu_acs"
-    db(4).Name = "lpu_budget"
-    db(5).Name = "lpu_hir"
-    db(6).Name = "lpu_im"
-    db(7).Name = "lpu_ter"
-    db(8).Name = "quarter"
-    db(9).Name = "quarter_rm"
-    
-    ReDim db(1).Fields(5)
-    With db(1)
-        .Fields(1) = "rep_id"
-        .Fields(2) = "firstname"
-        .Fields(3) = "lastname"
-        .Fields(4) = "region"
-        .Fields(5) = "city"
-    End With
-    
-    ReDim db(2).Fields(5)
-    With db(2)
-        .Fields(1) = "id"
-        .Fields(2) = "rep_id"
-        .Fields(3) = "name"
-        .Fields(4) = "address"
-        .Fields(5) = "beds"
-    End With
-    
-    ReDim db(3).Fields(7)
-    With db(3)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(4).Fields(6)
-    With db(4)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "bdgt_NMG"
-        .Fields(5) = "bdgt_NFG"
-        .Fields(6) = "sale_PLAN"
-    End With
-    
-    ReDim db(5).Fields(15)
-    With db(5)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "operations_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_ambulator_clexan_40mg"
-        .Fields(11) = "patients_ambulator_clexan_20mg"
-        .Fields(12) = "patients_stationar_nmg"
-        .Fields(13) = "patients_stationar_clexan"
-        .Fields(14) = "patients_stationar_clexan_40mg"
-        .Fields(15) = "patients_stationar_clexan_20mg"
-    End With
-    
-    
-    ReDim db(6).Fields(7)
-    With db(6)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(7).Fields(11)
-    With db(7)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_stationar_nmg"
-        .Fields(11) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(8).Fields(9)
-    With db(8)
-        .Fields(1) = "ID"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "rep_id"
-        .Fields(4) = "sale_plan"
-        .Fields(5) = "ClxnH20mg"
-        .Fields(6) = "ClxnH40mg"
-        .Fields(7) = "ClxnT40mg"
-        .Fields(8) = "ClxnC_IM"
-        .Fields(9) = "ClxnC_ACS"
-    End With
-    
-    ReDim db(9).Fields(3)
-    With db(9)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "sale_plan"
-    End With
-    
-    Dim rm_idx As Integer
-    Dim to_db As Object
-    'back uo
-    Merge_BackUp_All_Data
-    
-    'clean up
-    Merge_Clear_All_Data fm_file
-    
-    Set to_db = dbGetConnection(fm_file)
-    
-    For rm_idx = 1 To UBound(rm_files)
-        Dim from_db As Object
-        
-        Set from_db = dbGetConnection(rm_files(rm_idx))
-        
-        Dim new_rm_id As Long
-        new_rm_id = dbMergeRM(from_db, to_db)
-
-        Dim i As Integer
-
-        For i = 1 To UBound(db)
-            Dim get_sql As String
-            Dim getRS As Object
-            Dim insRS As Object
-            Dim field_idx As Integer
-                        
-            get_sql = "SELECT * FROM " & db(i).Name
-            Set getRS = CreateObject("ADODB.Recordset")
-            Set insRS = CreateObject("ADODB.Recordset")
-            insRS.Open db(i).Name, to_db, 2, 2
-
-            getRS.Open get_sql, from_db
-            
-            If Not getRS.BOF Then
-                Do While Not getRS.EOF
-                    insRS.addnew
-                    Dim fld_name As String
-                    
-                    For field_idx = 1 To UBound(db(i).Fields)
-                        fld_name = db(i).Fields(field_idx)
-                        insRS(fld_name) = getRS(fld_name)
-                    Next field_idx
-                    
-                    insRS("rm_id") = new_rm_id
-                    insRS.Update
-                    getRS.MoveNext
-                Loop
-            
-            Else
-                'empty table
-                ' do nothing
-            End If
-            
-            
-        Next i
-        
-        dbCloseOpenedConnection from_db
-    Next rm_idx
-    
-    dbCloseOpenedConnection to_db
-End Sub
-
-Function dbMergeRM(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM reg_man"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about Regional Manager! This database cannot be merged!!!"
-            dbMergeRM = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "reg_man", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    dbMergeRM = insertRecordset("mgr_id")
-    
-End Function
-
-Sub cmDataImport()
-    Dim def_dir As String
-    Dim flist() As String
-    Dim i As Integer
-
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        
-        If i > 0 Then
-            ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-        End If
-    End If
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-
-<<<<<<
-======================
-PRJ_QTR
->>>>>>
-Attribute VB_Name = "PRJ_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CPRJ_QT As Integer = 0
-Const CPRJ_ID As Integer = 1
-Const CPRJ_PLN As Integer = 2
-Const CPRJ_FCT As Integer = 3
-Const CPRJ_BDG As Integer = 4
-Const CPRJ_CNT As Integer = 5
-Const CPRJ_BEDS As Integer = 6
-Const CPRJ_HIR As Integer = 7
-Const CPRJ_TER As Integer = 8
-Const CPRJ_CRD As Integer = 9
-Const CPRJ_CLXN_BDG As Integer = 10
-Const CPRJ_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("PRJ_QTR")
-        s = "��� �������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tREGION
-    Dim i As Long
-    Dim r As Range
-
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objQTR(), 0)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CPRJ_QT) = objQTR(i).ent_date
-            r.Offset(i - 1, CPRJ_ID) = ""
-            r.Offset(i - 1, CPRJ_PLN) = objQTR(i).sale_PLAN
-            r.Offset(i - 1, CPRJ_FCT) = objQTR(i).total_SALE
-            r.Offset(i - 1, CPRJ_BDG) = objQTR(i).total_BDGT
-            r.Offset(i - 1, CPRJ_CNT) = objQTR(i).total_LPU
-            r.Offset(i - 1, CPRJ_BEDS) = objQTR(i).total_REP
-            r.Offset(i - 1, CPRJ_HIR) = objQTR(i).total_HIR
-            r.Offset(i - 1, CPRJ_TER) = objQTR(i).total_TER
-            r.Offset(i - 1, CPRJ_CRD) = objQTR(i).total_ACS
-            If objQTR(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_BDG) = objQTR(i).total_SALE / objQTR(i).total_BDGT
-            End If
-            If objQTR(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_NMG) = objQTR(i).total_SALE / objQTR(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CPRJ_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_CLXN_NMG + 1)
-        End If
-    Next i
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Public Sub cbxPRJ_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_PRJ
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_PRJ
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_PRJ
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = PRJ_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CPRJ_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "PRJ_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btPRJ_QTR_Do_IT ' old btRM_OTR_DO_IT
-End Sub
-
-<<<<<<
-======================
-RM_LIST
->>>>>>
-Attribute VB_Name = "RM_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentRM_ID() As Long
-    Dim r As Range
-
-    With Worksheets("RM_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CRM_ID)
-    End With
-
-    getCurrentRM_ID = r
-End Function
-
-Public Sub RM_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("PM_CHR_IDX")
-        Case 1
-            Rm_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rm_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rm_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-
-        Case 4
-            Rm_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectRM_QTR(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "RM_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("RM_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Public Sub SelectREP_LIST(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "REP_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .setEnt_date (getEnt_date())
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateRMList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Sub UpdateRMList()
-    Dim rmcd() As tRMID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_RM_CommonList_by_QTR(rmcd(), ent_date)
-
-    With ThisWorkbook.Worksheets("RM_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rmcd)
-            r.Offset(i - 1, CRM_NAME) = GetRegionName(rmcd(i).rm.Region)
-            r.Offset(i - 1, CRM_ID) = rmcd(i).rm.rm_id
-            r.Offset(i - 1, CRM_BEDS) = rmcd(i).rgcd(1).total_BEDS
-            r.Offset(i - 1, CRM_BDGT) = rmcd(i).rgcd(1).total_BDGT
-            r.Offset(i - 1, CRM_NMG) = rmcd(i).rgcd(1).total_BDGT_NMG
-            r.Offset(i - 1, CRM_HIR) = rmcd(i).rgcd(1).total_HIR
-            r.Offset(i - 1, CRM_TER) = rmcd(i).rgcd(1).total_TER
-            r.Offset(i - 1, CRM_CAR) = rmcd(i).rgcd(1).total_ACS
-            r.Offset(i - 1, CRM_FACT) = rmcd(i).rgcd(1).total_SALE
-            r.Offset(i - 1, CRM_PLAN) = rmcd(i).rgcd(1).sale_PLAN
-            
-            With rmcd(i).rgcd(1)
-                r.Offset(i - 1, CRM_PAT_LPU) = .total_HIR + .total_TER + .total_ACS
-            End With
-            
-            r.Offset(i - 1, CRM_BDGT_1) = rmcd(i).rgcd(1).total_BDGT
-            If rmcd(i).rgcd(1).total_BDGT > 0 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = rmcd(i).rgcd(1).total_SALE / rmcd(i).rgcd(1).total_BDGT
-            End If
-            If r.Offset(i - 1, CRM_BDGT_1 + 1) > 1 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CRM_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CRM_AREA).row, CRM_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CRM_AREA).Column
-
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CRM_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CRM_NAME
-        Range("JUMP") = ""
-    Else
-        btRM_LIST_DO_IT
-    End If
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-<<<<<<
-======================
-mPRJ_QTR
->>>>>>
-Attribute VB_Name = "mPRJ_QTR"
-Sub btPRJ_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("PRJ_ACTION")
-    ent_date = Worksheets(PRJ_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            cmDataImport
-        Case 2
-            Worksheets("RM_LIST").setEnt_date (Worksheets("PRJ_QTR").getEnt_date())
-            Worksheets("RM_LIST").Range("ret_addr") = "PRJ_QTR"
-            Worksheets("RM_LIST").Select
-        Case 3
-            cmNewReport
-    End Select
-    Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-End Sub
-
-
-<<<<<<
-======================
-mRM_LIST
->>>>>>
-Attribute VB_Name = "mRM_LIST"
-Option Explicit
-
-Public Const CRM_AREA As String = "B12"
-Public Const CRM_NAME As Integer = 0
-Public Const CRM_NAME1 As Integer = 1
-Public Const CRM_NAME2 As Integer = 2
-Public Const CRM_ID As Integer = 3
-Public Const CRM_BEDS As Integer = 4
-Public Const CRM_BDGT As Integer = 5
-Public Const CRM_NMG As Integer = 6
-Public Const CRM_HIR As Integer = 7
-Public Const CRM_TER As Integer = 8
-Public Const CRM_CAR As Integer = 9
-Public Const CRM_FACT As Integer = 10
-Public Const CRM_PLAN As Integer = 11
-Public Const CRM_PAT_LPU As Integer = 16
-Public Const CRM_BDGT_1 As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(CRM As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_LIST")
-        s = "�������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub Rm_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub Rm_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CRM_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub btRM_LIST_RET_IT()
-    With Worksheets("RM_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "PRJ_QTR"
-    End With
-    ThisWorkbook.Worksheets("PRJ_QTR").Activate
-End Sub
-
-
-Sub btRM_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rm_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("RM_LIST_ACTION")
-    With Worksheets("RM_LIST")
-        rm_id = .getCurrentRM_ID()
-        
-        Select Case i
-            Case 1:
-                .SelectRM_QTR rm_id
-            Case 2:
-                .SelectREP_LIST rm_id
-            End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-
-<<<<<<
-Project Name : 'ClexaneMR'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).ClearRepName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(REP_QTR_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-Const CQTR_PAT_ALL As Integer = 16
-Const CQTR_BDGT_ALL As Integer = 17
-
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRepName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-    Range("H5") = ""
-End Sub
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREP
-    
-    cRep = GetREPRecord
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-    
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    i = GetAll_QTR_Records(objQTR, "%")
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList(qcd)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_plan
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_BBL_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-
-Private Sub Worksheet_Activate()
-  
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-    
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CRow_Width Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-    
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub DO_New_qtr()
-    Dim res As Variant
-    Dim objQTR As tQTR
-    Dim s As String
-    s = GetLastQtr
-    objQTR.entry_date = GetNextQTR(s)
-    
-    If objQTR.entry_date = "" Then
-        Exit Sub
-    End If
-    
-    DO_Price_qtr objQTR.entry_date
-
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        Dim qtr As tQTR
-        Dim res As Integer
-        
-        qtr = Get_QTR_Record(ent_date)
-        
-        If qtr.id = 0 Then
-            qtr.entry_date = ent_date
-    
-            With Worksheets(VAR_SHEET)
-                qtr.ClxnH20mg = .Range("ClxnH20mg")
-                qtr.ClxnH40mg = .Range("ClxnH40mg")
-                qtr.ClxnT40mg = .Range("ClxnT40mg")
-                qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-                qtr.ClxnC_IM = .Range("ClxnC_IM")
-            End With
-        End If
-        
-        Dim dlg_nq As dlg_nextQTR
-        Set dlg_nq = New dlg_nextQTR
-        
-        With dlg_nq
-            .tb_qtr_name = qtr.entry_date
-            .tb_bdgt_avts = qtr.sale_plan
-            .tb_qtr_name = qtr.entry_date
-            .tb_ClxnH20mg = qtr.ClxnH20mg
-            .tb_ClxnH40mg = qtr.ClxnH40mg
-            .tb_ClxnT40mg = qtr.ClxnT40mg
-            .tb_ClxnC_ACS = qtr.ClxnC_ACS
-            .tb_ClxnC_IM = qtr.ClxnC_IM
-        End With
-        
-        dlg_nq.Show
-        res = dlg_nq.Tag
-        
-        If res = vbOK Then
-            With dlg_nq
-                If Not IsNumeric(.tb_bdgt_avts) Then
-                    MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                Else
-                    If .tb_bdgt_avts = 0 Then
-                        MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                        Exit Sub
-                    End If
-                End If
-                Dim bool As Boolean
-                bool = IsNumeric(.tb_ClxnH20mg) _
-                    And IsNumeric(.tb_ClxnH40mg) _
-                    And IsNumeric(.tb_ClxnT40mg) _
-                    And IsNumeric(.tb_ClxnC_ACS) _
-                    And IsNumeric(.tb_ClxnC_IM)
-                If Not bool Then
-                    MsgBox "������� ��������� �����", vbOK, PROGRAM_NAME
-                    Exit Sub
-                End If
-                qtr.sale_plan = .tb_bdgt_avts
-                qtr.entry_date = .tb_qtr_name
-                qtr.ClxnH20mg = .tb_ClxnH20mg
-                qtr.ClxnH40mg = .tb_ClxnH40mg
-                qtr.ClxnT40mg = .tb_ClxnT40mg
-                qtr.ClxnC_ACS = .tb_ClxnC_ACS
-                qtr.ClxnC_IM = .tb_ClxnC_IM
-            End With
-            Insert_QTR_Record qtr
-        End If
-    End If
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = False
-            .Range("ent_date") = ent_date
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        Dim i As Integer
-        i = MsgBox("������� ������ �� ������ [" & ent_date & "]?", vbDefaultButton2 + vbOKCancel, PROGRAM_NAME)
-        If i = vbOK Then
-            Dim objQTR As tQTR
-            If ent_date <> "" Then
-                objQTR.entry_date = ent_date
-                objQTR = Get_QTR_Record(ent_date)
-                Delete_QTR_Record objQTR
-                Worksheets(TITLE_SHEET).Select
-                Worksheets(REP_QTR_SHEET).Select
-            End If
-        End If
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            DO_New_qtr
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            dbExport
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    End Select
-    If idx <> 2 Then
-        With ThisWorkbook
-            .Worksheets(TITLE_SHEET).Select
-            .Worksheets(REP_QTR_SHEET).Select
-        End With
-    End If
-End Sub
-
-Sub Delete_qtr()
-    Dim ent_date As String
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    DO_Delete_qtr ent_date
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[MR]"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-    
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-    
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-        
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-                   
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-       
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CINP_WIDTH Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-    
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-        
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    lpu_id = r
-    
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-    
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-    
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-            
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-        
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-        
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-        
-        Case Else
-            Range("JUMP") = ""
-    End Select
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-    
-    is_input_range = INPUT_NO
-    
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-    
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREP
-    
-    ' ent_date = "%" ' % - all records
-    ent_date = getEnt_date
-    
-    objQTR = Get_QTR_Record(ent_date)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-     
-    ' ������� ���
-    Range("C3:C4").ClearContents
-    cRep = GetREPRecord
-    
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_plan
-    
-
-    
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-        
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-            
-         
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_plan
-            
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-            
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{566B33D6-957A-43E4-8444-D8EA3889700C}{42EE65B8-F8C6-4F95-9F52-7738BF6FCEAD}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-    
-        Dim objHir As tHIRURGIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.Count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-        
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-    
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-            Application.ScreenUpdating = False
-            
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-            
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{EBA94131-180E-4709-A2A3-B60D48987620}{47A860A1-BF92-4EBB-A333-AB7E83FAB868}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_plan = Round(Range("F13").Value, 0)
-            
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_plan
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_plan <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("��������� ������� ��������?", vbYesNo, PROGRAM_NAME) Then
-                    Insert_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-    
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_plan
-    
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    objQTR = Get_QTR_Record(ent_date)
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-    
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-        
-        SetupData cLPU
-        
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case INPUT_CHECK
-            
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{E3F10C5A-A4B4-42FF-A2C9-6F8198210A07}{563D0F3D-F79D-48F1-AFE4-A2136809B982}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{137EDDE5-3DB4-4BAD-A245-324DC31ABB36}{3BD7159A-BF6C-403F-B3DF-4834FA9E4D92}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{8EB80D4C-3476-421A-A370-6332A07DE509}{A7542905-C9F8-4F39-AD67-B62A88F8F4E6}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREP
->>>>>>
-Attribute VB_Name = "mREP"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSetREPRecord
-    With Worksheets("REP_QTR")
-        .ClearRepName
-        .Range("REP_QTR_INPUT_DATA").ClearContents
-        .Range("QTR_SEL") = ""
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-        Worksheets("REP_QTR").Range("QTR_SEL") = ""
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cUser As tREP
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cUser = GetREPRecord()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cUser.Region
-        .Range("IDX_CITY") = cUser.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cUser.Region
-        .cbCity = cUser.City
-        .tbFName = cUser.FirstName
-        .tbLName = cUser.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cUser
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        SetREPRecord cUser
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_plan As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim SQL As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_plan = 0
-    End With
-        
-    
-    SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_plan = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_plan = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_plan
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_plan & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPU(allLPU() As tLPU) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPU = dbGetAllLPU(dbConnection, allLPU)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPUbyQTR(allLPU() As tLPU, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPUbyQTR = dbGetAllLPUbyQTR(dbConnection, allLPU, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objLPU.id = 0 then insert else update
-Sub Insert_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    If objLPU.id = 0 Then
-        dbInsert_LPU_Record dbConnection, objLPU
-    Else
-        dbUpdate_LPU_Record dbConnection, objLPU
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub Delete_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDelete_LPU_Record dbConnection, objLPU
-    dbCloseConnection dbConnection
-End Sub
-
-Sub Delete_LPU_RecordQTR(ByRef objLPU As tLPU, ent_date As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-    dbCloseConnection dbConnection
-    
-End Sub
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim SQL As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    SQL = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Sub dbInsert_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-  
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu", dbConnection, 2, 2
-    dbRecordset.addnew
-    dbRecordset("name") = objLPU.name
-    dbRecordset("address") = objLPU.address
-    dbRecordset("rep_id") = objLPU.rep_id
-    dbRecordset("beds") = objLPU.beds
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objLPU.id = dbRecordset("id")
-  
-End Sub
-
-Sub dbUpdate_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu SET " & _
-    "name='" & objLPU.name & "'," & _
-    "address='" & objLPU.address & "'," & _
-    "beds=" & objLPU.beds & "," & _
-    "rep_id=" & objLPU.rep_id& & _
-    " WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-
-Function dbGetAllLPU(dbConnection As Object, allLPU() As tLPU) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu"
-    getAll_LPU_SQL = "SELECT * FROM lpu"
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPU = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAllLPUbyQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim where As String
-    where = "WHERE lpu_budget.entry_date like '" & ent_date & "'"
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget " & where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & where & " AND lpu.id=lpu_budget.lpu_id"
-    
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPUbyQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Sub dbDelete_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu " & _
-    "WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Hir_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Ter_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_ACS_RecordsByLPU_ID dbConnection, objLPU.id
-    
-End Sub
-
-Sub dbDelete_LPU_RecordQTR(dbConnection As Object, ByRef objLPU As tLPU, ent_date As String)
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-End Sub
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-Option Explicit
-
-Public Type tREP
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetREPRecord() As tREP
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetREPRecord = dbGetREPRecord(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub SetREPRecord(cUser As tREP)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSetREPRecord dbConnection, cUser
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSetREPRecord()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSetREPRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGetREPRecord(dbConnection As Object) As tREP
-    
-    Dim SQL As String
-    Dim objREP As tREP
-    
-    objREP.FirstName = ""
-    objREP.LastName = ""
-    objREP.Region = 0
-    objREP.City = 0
-    SQL = "SELECT firstname, lastname, region, city FROM " & _
-          "rep"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREP.FirstName = dbRecordset("firstname")
-        objREP.LastName = dbRecordset("lastname")
-        objREP.Region = dbRecordset("region")
-        objREP.City = dbRecordset("city")
-        
-    End If
-    
-    dbGetREPRecord = objREP
-        
-End Function
-
-Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREP.FirstName & "', " & _
-    "'" & objREP.LastName & "', " & _
-    objREP.Region & ", " & _
-    objREP.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-End Sub
-
-Public Sub dbReSetREPRecord(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("REP_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-'                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = Double2Str(.risk_percent, 3)
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub test()
-    Dim s As String
-    Dim d As Single
-    d = 1235.6789
-    s = Format(d, "####0,00")
-    MsgBox s
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    Dim del_request As Integer
-    Dim allLPU() As tLPU
-    Dim lpu_count As Integer
-    Dim i As Integer
-    Dim tmp_LPU_List As Range
-    Dim tmp_LPU_List_Addr As String
-    Dim r_end As Range
-    Dim dlg As Dlg_lpu_card
-    
-    Set dlg = New Dlg_lpu_card
-    
-    lpu_count = GetAllLPU(allLPU)
-    With Worksheets(VAR_SHEET)
-        Set tmp_LPU_List = .Range("tmp_LPU_List")
-        Set r_end = .Range(tmp_LPU_List, tmp_LPU_List.End(xlDown))
-        Set r_end = .Range(r_end, r_end.End(xlToRight))
-        .Range(tmp_LPU_List, r_end).ClearContents
-    End With
-        
-    If lpu_count <> 0 Then
-        dlg.cbxLPU_List_Enable.Enabled = True
-        For i = 1 To UBound(allLPU)
-            tmp_LPU_List.Cells(i, 1) = allLPU(i).name
-            tmp_LPU_List.Cells(i, 2) = allLPU(i).address
-            tmp_LPU_List.Cells(i, 3) = allLPU(i).beds
-            tmp_LPU_List.Cells(i, 4) = allLPU(i).id
-        Next i
-    Else
-        dlg.cbxLPU_List_Enable.Enabled = False
-    End If
-    
-    tmp_LPU_List_Addr = Worksheets(VAR_SHEET).name & "!" & _
-            Worksheets(VAR_SHEET).Range(tmp_LPU_List, tmp_LPU_List.End(xlDown)).address
-
-    With dlg
-        .cbLPU_List.RowSource = tmp_LPU_List_Addr
-        .cbLPU_List.ListIndex = 0
-        .cbxLPU_List_Enable = False
-        .cbLPU_List.Enabled = False
-        If cLPU.id <> 0 Then
-            .cbxLPU_List_Enable.Enabled = False
-        Else
-            If lpu_count <> 0 Then
-                .cbxLPU_List_Enable.Enabled = True
-            Else
-                .cbxLPU_List_Enable.Enabled = False
-            End If
-        End If
-        .tb_lpu_name.Text = cLPU.name
-        .tb_lpu_address.Text = cLPU.address
-        .tbBedsCount = cLPU.beds
-
-        .Tag = vbCancel
-    End With
-    
-    dlg.Show
-    
-    If Not IsNumeric(dlg.Tag) Then
-        Exit Sub
-    End If
-    
-    If dlg.Tag = vbOK Then
-        Dim n As Variant
-        Dim test As Integer
-        test = 0
-        n = dlg.tbBedsCount.Value
-        If Not IsNumeric(n) Then
-            test = 1
-        Else
-            If n = 0 Then
-                test = 1
-            End If
-        End If
-        If test = 0 Then
-            
-            cLPU.name = dlg.tb_lpu_name.Text
-            cLPU.address = dlg.tb_lpu_address.Text
-            cLPU.beds = dlg.tbBedsCount.Value
-                                    
-            If cLPU.name = "" Or cLPU.address = "" Then
-                test = 2
-            End If
-        End If
-        Select Case test
-            Case 0
-                If dlg.cbxLPU_List_Enable.Value = True Then
-                    cLPU.id = tmp_LPU_List.Cells(dlg.cbLPU_List.ListIndex + 1, 4)
-                End If
-                Insert_LPU_Record cLPU
-                ' ��������� ������� ������ ��� ��� � ��������
-                Dim bdgt As tBUDGET
-                bdgt = Get_BDGT_Record(cLPU.id, ent_date)
-                ' ������ ���: ������� ������ ������ � lpu_budget
-                If bdgt.id = 0 Then
-                    bdgt.lpu_id = cLPU.id
-                    bdgt.entry_date = ent_date
-                    Insert_BDGT_Record bdgt
-                End If
-            Case 1
-                MsgBox "������� ��������� ���������� ������ ����� ��� 1!", vbOKOnly, PROGRAM_NAME
-            Case 2
-                MsgBox "������������ � ����� ��� �� ������ ���� �������!", vbOKOnly, PROGRAM_NAME
-        End Select
-    End If
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-    
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-    
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-    
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & "."
-        .Show
-        
-        If .Tag = vbOK Then
-            If .chbDeleteAll.Value Then
-                delete_all = _
-                    MsgBox("��� ������ �� ��� � ������ '" & cLPU.name & _
-                    "' ����� ������� ��������.", vbOK, PROGRAM_NAME)
-                If delete_all = vbOK Then
-                    Delete_LPU_Record cLPU
-                End If
-            Else
-                Delete_LPU_RecordQTR cLPU, ent_date
-            End If
-        End If
-    End With
-    
-    With ThisWorkbook
-        .Worksheets(TITLE_SHEET).Select
-        .Worksheets("LPU_LIST").Select
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Activate
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-        
-    
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id <> 0 And i = 1 Then
-            lpu_id = 0
-        End If
-        If lpu_id = 0 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1, 6
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                If lpu_id <> 0 Then
-                    .SelectLPU_BDGT lpu_id, ent_date
-                    .Range("JUMP") = "LPU_BDGT"
-                End If
-            Case 3
-                If lpu_id <> 0 Then
-                    .SelectLPU_HIR lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_HIR"
-                End If
-            Case 4
-                If lpu_id <> 0 Then
-                    .SelectLPU_TER lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_TER"
-                End If
-            Case 5
-                If lpu_id <> 0 Then
-                    .SelectLPU_C_ACS lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_C_ACS"
-                End If
-        End Select
-    End With
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_plan As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    Else
-        getLast_QTR_SQL = ""
-    End If
-    
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Sub Insert_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTR.id <> 0 Then
-        dbUpdate_QTR_Record dbConnection, objQTR
-    Else
-        dbInsert_QTR_Record dbConnection, objQTR
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTR_Record(ent_date As String) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, ent_date)
-    If i <> 0 Then
-        Get_QTR_Record = allQTR(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records(ByRef All_QTR() As tQTR, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTR_Records = dbGetAll_QTR_Records(dbConnection, All_QTR, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTR_Record dbConnection, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTR.ID <> 0 then updatre else insert
-Sub dbInsert_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTR
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_plan
-        dbRecordset("rep_id") = .rep_id
-        dbRecordset("ClxnH20mg") = .ClxnH20mg
-        dbRecordset("ClxnH40mg") = .ClxnH40mg
-        dbRecordset("ClxnT40mg") = .ClxnT40mg
-        dbRecordset("ClxnC_IM") = .ClxnC_IM
-        dbRecordset("ClxnC_ACS") = .ClxnC_ACS
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTR.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim Update_SQL As String
-    
-    With objQTR
-        Update_SQL = "UPDATE quarter SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rep_id=" & .rep_id & "," & _
-            "sale_plan=" & .sale_plan & "," & _
-            "ClxnH20mg=" & .ClxnH20mg & "," & _
-            "ClxnH40mg=" & .ClxnH40mg & "," & _
-            "ClxnT40mg=" & .ClxnT40mg & "," & _
-            "ClxnC_IM=" & .ClxnC_IM & "," & _
-            "ClxnC_ACS=" & .ClxnC_ACS & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTR_Records(dbConnection As Object, All_QTR() As tQTR, ent_date As String) As Integer
-    
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter WHERE entry_date like '" & ent_date & "'"
-    getAll_QTR_SQL = "SELECT * FROM quarter WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTR_Records = QTR_Count
-    
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim All_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_plan = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 All_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter " & _
-    "WHERE id=" & objQTR.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Hir_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Ter_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_ACS_RecordsByQTR dbConnection, objQTR.entry_date
-       
-End Sub
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList(ByRef qcd() As tQTR_COMMON) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList = dbGet_QTR_CommonList(dbConnection, qcd)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList(dbConnection As Object, ByRef qcd() As tQTR_COMMON) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, "%")
-    dbGet_QTR_CommonList = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_plan
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    On Error GoTo l_exit
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-l_exit:
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-        .EditDirectlyInCell = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{2FC04B4C-EB99-433E-ACDB-A920D02B9B5B}{777B85CC-ADE3-4188-94C8-9E07DA8B5076}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    On Error GoTo ExitLabel
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.Count
-                On Error Resume Next
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{3F7D7D75-90F6-4829-9E24-CA5391BB2A03}{A1A0F296-0D28-4123-8E38-82FA6EE6F2EF}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAllLPUbyQTR(dbConnection, allLPU, objQTR.entry_date)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-   
-    Unprotect
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-        
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{91AE5FA0-01C7-4C10-9E5F-D1D2DDF29401}{5726592A-BC0A-4E79-A963-35D354045716}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{FB055133-927F-41FF-BC90-442833A40591}{11BCAB43-1EDD-440B-AB0E-20CD6E42E11A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tID_REP
-    id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Public Type tID_REP_COMMON
-    id_rep As tID_REP
-    i_qtr As Long
-    qtrs As tQTR_COMMON
-End Type
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim last_qtr As String
-    
-    On Error GoTo ErrHandler
-    
-    last_qtr = GetLastQTR_fromDB
-    If last_qtr = "" Then
-        MsgBox "��� ������� � ���� ������. ������� ����������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & last_qtr & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub t()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-Project Name : 'ClexanePM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    Application.ScreenUpdating = True
-'    CheckUser
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).update_history
-    Application.Calculate
-
-End Sub
-
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "QTR_SEL"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Worksheets(REP_QTR_SHEET).Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .setEnt_date (ent_date)
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).getEnt_date()
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public ppReport As New cPPReport
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[PM]"
-Public Const PROGRAM_VERSION As String = "Clexane[PM] ver 1.1"
-Public Const PROGRAM_FILENAME As String = "clexane-pm"
-Public Const PROGRAM_BACKUPNAME As String = "pm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "pm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "rm-ex*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-Public Const CHART_DEF_TITLE As String = "* * *"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20031207
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O41"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-Public Const PRJ_QTR_SHEET As String = "PRJ_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Function time_correct(end_date As Long, ByVal theDate As Date) As Boolean
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-    If end_date = NO_ESTIMATION_DATE Then
-        time_correct = True
-        Exit Function
-    End If
-    
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    
-    time_correct = CurDate <= end_date
-    
-End Function
-
-Sub EnableRun(end_date As Long)
-    If Not time_correct(end_date, Now) Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub t()
-    EnableRun ESTIMATION_DATE
-End Sub
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Sub OpenPPT()
-    ppReport.ReportView
-End Sub
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    SelectLPU_BDGT lpu_id, ent_date
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .setEnt_date (ent_date)
-            .Range("lpu_id") = lpu_id
-            .Range("REP_ID") = rep_id
-            .Range("RM_ID") = rm_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("RM_ID") = rm_id
-        .Range("REP_ID") = rep_id
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.Name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{32FB0F3D-6884-41DC-99DB-E2C55B2257C4}{DED79A66-DA60-4CCC-9003-082480235D55}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{0DC9E035-CE0A-49FF-85A2-A4EC5FF8FE96}{D54DDC8A-1EE2-4BB3-8B94-343B521AF098}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S15"
-
-Sub PrintCopy()
-    Range("B1:K21").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), Range("RM_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    objLPU = Get_LPU_Record(id, Range("RM_ID"))
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.Name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BFB4547C-96A7-4739-AA0A-CEF1E35E2BDC}{C3D618A3-9410-4BC7-9D93-3B049D361132}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.Name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-    sh.Range("ret_addr") = ""
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{9AAD262F-A6C4-4912-9C58-D7A2071181B8}{9470F4EB-DA9F-4584-9159-D09319548D21}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{A8FBEE9C-DE59-49DE-971D-07BC9C0E9BD2}{C712732B-D8E4-4C2D-8E78-AC90968E0CD7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hw_reset()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        MsgBox "2"
-        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-'    Dim cREGMAN As tREGMAN
-'    Dim idx As Integer
-'    Dim dlg_ui As UserInfo
-'
-'    Set dlg_ui = New UserInfo
-'
-'    cREGMAN = Get_REGMAN_Record()
-'
-'    With ThisWorkbook.Worksheets(REGS_SHEET)
-'        .Range("IDX_REGION") = cREGMAN.Region
-'        .Range("IDX_CITY") = cREGMAN.City
-'    End With
-'
-'    With dlg_ui
-'        .cbRegion = cREGMAN.Region
-'        .cbCity = cREGMAN.City
-'        .tbFName = cREGMAN.FirstName
-'        .tbLName = cREGMAN.LastName
-'    End With
-'
-'    dlg_ui.Show
-'    Worksheets(REGS_SHEET).Calculate
-'
-'    If dlg_ui.Tag = vbOK Then
-'        With cREGMAN
-'            .Region = dlg_ui.cbRegion.Value
-'            .City = dlg_ui.cbCity.Value
-'            .FirstName = dlg_ui.tbFName.Value
-'            .LastName = dlg_ui.tbLName.Value
-'        End With
-'        Set_REGMAN_Record cREGMAN
-'    Else
-'        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-'    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    rm_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String, rm_id As Long) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String, rm_id As Long) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .rm_id = rm_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    rm_id As Long
-    Name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long, rm_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long, rm_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.Name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.Name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.rm_id = dbRecordset("rm_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id " & _
-    "AND lpu.rep_id=" & rep_id & " AND lpu.rm_id=lpu_budget.rm_id AND lpu.rm_id=" & rm_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds, lpu.rm_id AS rm_id " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .Name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cdbRM
->>>>>>
-Attribute VB_Name = "cdbRM"
-Option Explicit
-
-Public Type tRMID_COMMON
-    rm As tREGMAN
-    rgcd_count As Integer
-    rgcd() As tREGION
-End Type
-
-Function Get_RM_CommonList_by_QTR(ByRef rmcd() As tRMID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_RM_CommonList_by_QTR = dbGet_RM_CommonList_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_RM_CommonList_by_QTR(dbConnection As Object, ByRef rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    ' �������� ������ RM-��
-    Dim count As Integer
-    count = db_get_All_RM_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    Dim i As Integer
-    For i = 1 To count
-        rmcd(i).rgcd_count = 1
-        ReDim rmcd(i).rgcd(1 To 1)
-        getREGION_by_QTR ent_date, rmcd(i).rgcd(1), rmcd(i).rm.rm_id
-    Next i
-    dbGet_RM_CommonList_by_QTR = count
-End Function
-
-Function db_get_All_RM_by_QTR(dbConnection As Object, rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    
-    Dim count_sql As String
-    Dim get_sql As String
-    Dim rs As Object
-    Dim RM_Count As Integer
-        
-    count_sql = "SELECT COUNT(*) AS RM_TOTAL FROM reg_man"
-    get_sql = "SELECT * FROM reg_man"
-    Set rs = CreateObject("ADODB.Recordset")
-    rs.Open count_sql, dbConnection
-    
-    If Not rs.BOF Then
-        RM_Count = rs("RM_TOTAL")
-    End If
-    
-    rs.Close
-    
-     db_get_All_RM_by_QTR = RM_Count
-    
-    If RM_Count > 0 Then
-        'we have records
-        ReDim rmcd(1 To RM_Count)
-        Dim index As Long
-        index = 1
-        rs.Open get_sql, dbConnection
-        
-        If Not rs.BOF Then
-             Do While Not rs.EOF
-                 Dim tmp_rmcd As tRMID_COMMON
-                 With tmp_rmcd
-                    .rgcd_count = 0
-                    .rm.City = rs("city")
-                    .rm.FirstName = rs("firstname")
-                    .rm.LastName = rs("lastname")
-                    .rm.rm_id = rs("mgr_id")
-                    .rm.Region = rs("region")
-                 End With
-                 
-                 rmcd(index) = tmp_rmcd
-                 index = index + 1
-                 rs.MoveNext
-             Loop
-        End If
-    End If
-    
-End Function
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-           With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub CreateExtCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom extendet commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Add New Slide"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 280
-                .OnAction = "cmAddSlide"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        Application.ScreenUpdating = False
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        Application.ScreenUpdating = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmNewReport()
-    ppReport.CreateReport
-    MsgBox "����� ����� ������", vbInformation + vbOKOnly, PROGRAM_NAME
-    CreateExtCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmOpenReport()
-    Dim fileToOpen
-    Dim s As String
-    fileToOpen = Application _
-        .GetOpenFileName("Report Files (*.ppt), *.ppt", title:="Report OPen", MultiSelect:=False)
-    If fileToOpen <> False Then
-        s = fileToOpen
-        ppReport.OpenReport s
-        CreateExtCommandBar theApp:=ThisWorkbook.Application
-    End If
-End Sub
-
-Sub cmCloseReport()
-    On Error Resume Next
-    ppReport.SaveReport
-    CreateCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmAddSlide()
-    ThisWorkbook.ActiveSheet.PrintCopy
-    ppReport.InsertSlide
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("PRJ_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Unprotect
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("LPU_LIST")
-        s = .Range("C4") & " " & .Range("C3") & ", " & .Range("G4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-End Sub
-
-Sub btLPU_DEL_IT()
-'    Dim cLPU As tLPU
-'    Dim ent_date As String
-'    Dim delete_all As Integer
-'    Dim dlg_del As dlg_LPU_delete
-'
-'    With Worksheets("LPU_LIST")
-'        ent_date = .Range("ent_date")
-'        cLPU.id = .getCurrentLPU_ID()
-'    End With
-'
-'    If cLPU.id = 0 Then
-'        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-'        Exit Sub
-'    End If
-'    cLPU = Get_LPU_Record(cLPU.id)
-'
-'    Set dlg_del = New dlg_LPU_delete
-'    With dlg_del
-'        .chbDeleteQTR.Value = True
-'        .chbDeleteAll.Value = False
-'        .lComment = ent_date & ": �������� ��� '" _
-'        & cLPU.Name & "', �������������� �� ������:" _
-'        & cLPU.address & " �� ���������."
-'        .Show
-'    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    rm_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-        .rm_id = rm_id
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.rm_id = dbRecordset("rm_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id, rm_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    Dim rep_sql As String
-    Dim rm_sql As String
-    
-    rep_sql = ""
-    rm_sql = ""
-    
-    If rep_id <> 0 Then
-        rep_sql = " AND rep_id=" & rep_id
-    End If
-    
-    If rm_id <> 0 Then
-        rm_sql = " AND rm_id=" & rm_id
-    End If
-    
-    
-        getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql
-        getAll_QTR_SQL = "SELECT * FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql & " ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{92648543-CB84-4B6B-BEB3-539AE7EF9D84}{7E20E3E3-027A-483B-A14D-AA9EA5398ACC}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "��������� �����: " & Range("title")
-    Range("view_key") = False
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(%): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{067FED69-B41E-427D-AF59-5798B8E2E73A}{4C13CAB1-FDCC-4708-89EB-E92EDC125712}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id, objQTR.rm_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "���� ������: " & Range("title")
-    
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� ������: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "������� ���: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{9C81F4D2-4ECF-46F5-999B-9801D572A12F}{B382508B-7F3D-4747-8407-0F75F6F265F5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{EA8CE4CE-AC2E-45BC-BAF8-1429E6242097}{575F0762-04F4-4F86-B98A-8E87E3424B0D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(rep_id As Long, rm_id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, rep_id As Long, rm_id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT * FROM " & _
-          "rep WHERE rep_id=" & rep_id & " AND rm_id=" & rm_id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.rm_id = dbRecordset("rm_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    If rm_id <> 0 Then
-        Where = Where & " AND rep.rm_id=" & rm_id
-    End If
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record(Range("RM_ID"))
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN, Range("RM_ID"))
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record(rm_id As Long) As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSet_REGMAN_Record dbConnection, cREGMAN
-'    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object, rm_id As Long) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    objREGMAN.rm_id = rm_id
-    sql = "SELECT * FROM " & _
-          "reg_man WHERE mgr_id=" & rm_id
-          
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM reg_man"
-'    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREGMAN.FirstName & "', " & _
-'    "'" & objREGMAN.LastName & "', " & _
-'    objREGMAN.Region & ", " & _
-'    objREGMAN.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    Name As String
-End Type
-
-Public Type tDBTABLE
-    Name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).Name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).Name = "entry_date"
-    tables(1).field(2).Name = "bdgt_NMG"
-    tables(1).field(3).Name = "bdgt_NFG"
-    tables(1).field(4).Name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).Name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).Name = "entry_date"
-    tables(2).field(2).Name = "operations_per_quarter"
-    tables(2).field(3).Name = "risk_percent"
-    tables(2).field(4).Name = "patients_with_risk_ON"
-    tables(2).field(5).Name = "patients_ambulator"
-    tables(2).field(6).Name = "patients_ambulator_nmg"
-    tables(2).field(7).Name = "patients_ambulator_clexan"
-    tables(2).field(8).Name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).Name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).Name = "patients_stationar_nmg"
-    tables(2).field(11).Name = "patients_stationar_clexan"
-    tables(2).field(12).Name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).Name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).Name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).Name = "entry_date"
-    tables(3).field(2).Name = "patients_with_geparins"
-    tables(3).field(3).Name = "patients_per_quarter"
-    tables(3).field(4).Name = "patients_stationar_nmg"
-    tables(3).field(5).Name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).Name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).Name = "entry_date"
-    tables(4).field(2).Name = "patients_with_geparins"
-    tables(4).field(3).Name = "patients_per_quarter"
-    tables(4).field(4).Name = "patients_stationar_nmg"
-    tables(4).field(5).Name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).Name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).Name = "entry_date"
-    tables(5).field(2).Name = "patients_per_quarter"
-    tables(5).field(3).Name = "risk_percent"
-    tables(5).field(4).Name = "patients_with_risk_ON"
-    tables(5).field(5).Name = "patients_ambulator"
-    tables(5).field(6).Name = "patients_ambulator_nmg"
-    tables(5).field(7).Name = "patients_ambulator_clexan"
-    tables(5).field(8).Name = "patients_stationar_nmg"
-    tables(5).field(9).Name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).Name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).Name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).Name) = getRS(tables(tbl_idx).field(fld_idx).Name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 10)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    tables_to_clear(9) = "quarter_rm"
-    tables_to_clear(10) = "reg_man"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-cdbPRJ
->>>>>>
-Attribute VB_Name = "cdbPRJ"
-Option Explicit
-
-Type tPROJECT
-    total_SALE  As Long ' ����� ����� ������
-    total_BDGT  As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU   As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_RM    As Long ' ����� �����
-    total_BEDS  As Long ' ����� ����� ����
-    total_HIR   As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER   As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS   As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN   As Long '  ���� ������ ��������
-    objRGN() As tREGION
-End Type
-
-Function GetPRJ_COMM_DATA(ByRef prj_data As tPROJECT) As Integer
-    Dim i As Integer
-    i = GetRGN_COMM_DATA(prj_data.objRGN, 0)
-    GetPRJ_COMM_DATA = i
-    If i > 0 Then
-        With prj_data
-            .sale_PLAN = 0
-            .total_ACS = 0
-            .total_BDGT = 0
-            .total_BDGT_NMG = 0
-            .total_BEDS = 0
-            .total_HIR = 0
-            .total_LPU = 0
-            .total_REP = 0
-            .total_RM = 0
-            .total_SALE = 0
-            .total_TER = 0
-            For i = 1 To UBound(prj_data.objRGN)
-                
-            Next i
-        End With
-    End If
-
-End Function
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-        .setEnt_date (getEnt_date())
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("RM_ID") = rm_id
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    Dim rm_struc As tREGMAN
-    
-    i = Range("RM_ID")
-    rm_struc = Get_REGMAN_Record(i)
-    
-    Range("C4") = rm_struc.LastName
-    Range("C5") = rm_struc.FirstName
-
-    Range("G5") = GetRegionName(rm_struc.Region)
-    
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date, Range("RM_ID"))
-
-    
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_LIST")
-        s = .Range("C5") & " " & .Range("C4") & ", " & .Range("G5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("REP_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date, rm_id)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id, allREPID(i).rm_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    rm_id As Long
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION, rm_id As Long) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date, rm_id)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_REP_count As Integer
-            reg_data(i).rm_id = rm_id
-            reg_data(i).ent_date = q_date(i)
-            current_REP_count = getREGION_by_QTR(q_date(i), reg_data(i), rm_id)
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-' if rm_id = 0 then gets all records
-Function getAllQTRNames(ByRef qtr_lst() As String, rm_id As Long) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    
-    If rm_id <> 0 Then
-        sql = sql & " WHERE rm_id=" & rm_id
-    End If
-    
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION, rm_id As Long) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tQTR_COMMON
-    rep_count = Get_QTR_CommonList_by_REP(reps, ent_date, 0, rm_id)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .c_bdgt_NFG + .c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtr.sale_PLAN
-                treg.total_SALE = treg.total_SALE + .c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .c_pat_HIR
-                treg.total_TER = treg.total_TER + .c_pat_TER
-                treg.total_ACS = treg.total_ACS + .c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .i_lcd
-                treg.total_BEDS = treg.total_BEDS + .c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-'            def_dir = GetWBPath(ThisWorkbook.FullName)
-'            If GetImportDirectory(def_dir, flist) Then
-'                Dim db_list() As String
-'                i = GetDBList(flist, db_list)
-'                If i > 0 Then
-'                    ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-'                End If
-'            End If
-'            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Range("ret_addr") = "RM_QTR"
-            Worksheets("REP_LIST").setEnt_date (Worksheets(RM_QTR_SHEET).getEnt_date())
-            Worksheets("REP_LIST").Range("RM_ID") = Worksheets(RM_QTR_SHEET).Range("RM_ID")
-            Worksheets("REP_LIST").Range("VIEW_ONLY") = True
-
-            Worksheets("REP_LIST").Select
-        Case 3
-            MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub btRM_QTR_RET_IT()
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cPPReport
->>>>>>
-Attribute VB_Name = "cPPReport"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Const PPR_NON As Integer = 0
-Const PPR_NEW As Integer = 1
-Const PPR_OLD As Integer = 2
-
-Dim ReportApp As PowerPoint.Application
-Dim ReportDoc As PowerPoint.Presentation
-Dim ReportState As Integer
-Dim PowerPointPath As String
-
-Private Sub Class_Initialize()
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    PowerPointPath = ReportApp.Path & "\PowerPNT.EXE"
-    ReportState = PPR_NON
-End Sub
-
-Sub OpenReport(FileName As String)
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = GetObject(FileName)
-    ReportState = PPR_OLD
-End Sub
-
-Sub CreateReport()
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = ReportApp.Presentations.Add
-    ReportState = PPR_NEW
-End Sub
-
-Sub SaveReport()
-    Select Case ReportState
-        Case PPR_NEW
-            ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME
-        Case PPR_OLD
-            ReportDoc.Save
-    End Select
-    ReportState = PPR_NON
-End Sub
-
-Sub ReportView()
-    Dim CmdName As String
-    CmdName = GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME + ".PPT"
-    CmdName = PowerPointPath & " " & CmdName
-    Shell CmdName, 1
-End Sub
-
-Sub InsertSlide()
-    Dim ReportPage As PowerPoint.Slide
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.count + 1, ppLayoutBlank)
-    
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = "Slide #" & Format(ReportDoc.Slides.count)
-End Sub
-
-
-Private Sub Class_Terminate()
-    SaveReport
-    ReportApp.Quit
-End Sub
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{36355920-F7A4-44A8-96EF-5D79CF26137D}{F852BDF2-AB3E-468E-89DF-EC5DC0C7C88B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-rmImport
->>>>>>
-Attribute VB_Name = "rmImport"
-Option Explicit
-
-Public Type dbDESCRIPTION
-    Name As String
-    Fields() As String
-End Type
-
-Sub ImportFromRegionalManagers(rm_files() As String, fm_file As String)
-    Dim db(9) As dbDESCRIPTION
-    
-    '''''data
-    db(1).Name = "rep"
-    
-    db(2).Name = "lpu"
-    db(3).Name = "lpu_acs"
-    db(4).Name = "lpu_budget"
-    db(5).Name = "lpu_hir"
-    db(6).Name = "lpu_im"
-    db(7).Name = "lpu_ter"
-    db(8).Name = "quarter"
-    db(9).Name = "quarter_rm"
-    
-    ReDim db(1).Fields(5)
-    With db(1)
-        .Fields(1) = "rep_id"
-        .Fields(2) = "firstname"
-        .Fields(3) = "lastname"
-        .Fields(4) = "region"
-        .Fields(5) = "city"
-    End With
-    
-    ReDim db(2).Fields(5)
-    With db(2)
-        .Fields(1) = "id"
-        .Fields(2) = "rep_id"
-        .Fields(3) = "name"
-        .Fields(4) = "address"
-        .Fields(5) = "beds"
-    End With
-    
-    ReDim db(3).Fields(7)
-    With db(3)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(4).Fields(6)
-    With db(4)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "bdgt_NMG"
-        .Fields(5) = "bdgt_NFG"
-        .Fields(6) = "sale_PLAN"
-    End With
-    
-    ReDim db(5).Fields(15)
-    With db(5)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "operations_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_ambulator_clexan_40mg"
-        .Fields(11) = "patients_ambulator_clexan_20mg"
-        .Fields(12) = "patients_stationar_nmg"
-        .Fields(13) = "patients_stationar_clexan"
-        .Fields(14) = "patients_stationar_clexan_40mg"
-        .Fields(15) = "patients_stationar_clexan_20mg"
-    End With
-    
-    
-    ReDim db(6).Fields(7)
-    With db(6)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(7).Fields(11)
-    With db(7)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_stationar_nmg"
-        .Fields(11) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(8).Fields(9)
-    With db(8)
-        .Fields(1) = "ID"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "rep_id"
-        .Fields(4) = "sale_plan"
-        .Fields(5) = "ClxnH20mg"
-        .Fields(6) = "ClxnH40mg"
-        .Fields(7) = "ClxnT40mg"
-        .Fields(8) = "ClxnC_IM"
-        .Fields(9) = "ClxnC_ACS"
-    End With
-    
-    ReDim db(9).Fields(3)
-    With db(9)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "sale_plan"
-    End With
-    
-    Dim rm_idx As Integer
-    Dim to_db As Object
-    'back uo
-    Merge_BackUp_All_Data
-    
-    'clean up
-    Merge_Clear_All_Data fm_file
-    
-    Set to_db = dbGetConnection(fm_file)
-    
-    For rm_idx = 1 To UBound(rm_files)
-        Dim from_db As Object
-        
-        Set from_db = dbGetConnection(rm_files(rm_idx))
-        
-        Dim new_rm_id As Long
-        new_rm_id = dbMergeRM(from_db, to_db)
-
-        Dim i As Integer
-
-        For i = 1 To UBound(db)
-            Dim get_sql As String
-            Dim getRS As Object
-            Dim insRS As Object
-            Dim field_idx As Integer
-                        
-            get_sql = "SELECT * FROM " & db(i).Name
-            Set getRS = CreateObject("ADODB.Recordset")
-            Set insRS = CreateObject("ADODB.Recordset")
-            insRS.Open db(i).Name, to_db, 2, 2
-
-            getRS.Open get_sql, from_db
-            
-            If Not getRS.BOF Then
-                Do While Not getRS.EOF
-                    insRS.addnew
-                    Dim fld_name As String
-                    
-                    For field_idx = 1 To UBound(db(i).Fields)
-                        fld_name = db(i).Fields(field_idx)
-                        insRS(fld_name) = getRS(fld_name)
-                    Next field_idx
-                    
-                    insRS("rm_id") = new_rm_id
-                    insRS.Update
-                    getRS.MoveNext
-                Loop
-            
-            Else
-                'empty table
-                ' do nothing
-            End If
-            
-            
-        Next i
-        
-        dbCloseOpenedConnection from_db
-    Next rm_idx
-    
-    dbCloseOpenedConnection to_db
-End Sub
-
-Function dbMergeRM(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM reg_man"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about Regional Manager! This database cannot be merged!!!"
-            dbMergeRM = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "reg_man", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    dbMergeRM = insertRecordset("mgr_id")
-    
-End Function
-
-Sub cmDataImport()
-    Dim def_dir As String
-    Dim flist() As String
-    Dim i As Integer
-
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        
-        If i > 0 Then
-            ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-        End If
-    End If
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-
-<<<<<<
-======================
-PRJ_QTR
->>>>>>
-Attribute VB_Name = "PRJ_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CPRJ_QT As Integer = 0
-Const CPRJ_ID As Integer = 1
-Const CPRJ_PLN As Integer = 2
-Const CPRJ_FCT As Integer = 3
-Const CPRJ_BDG As Integer = 4
-Const CPRJ_CNT As Integer = 5
-Const CPRJ_BEDS As Integer = 6
-Const CPRJ_HIR As Integer = 7
-Const CPRJ_TER As Integer = 8
-Const CPRJ_CRD As Integer = 9
-Const CPRJ_CLXN_BDG As Integer = 10
-Const CPRJ_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("PRJ_QTR")
-        s = "��� �������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tREGION
-    Dim i As Long
-    Dim r As Range
-
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objQTR(), 0)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CPRJ_QT) = objQTR(i).ent_date
-            r.Offset(i - 1, CPRJ_ID) = ""
-            r.Offset(i - 1, CPRJ_PLN) = objQTR(i).sale_PLAN
-            r.Offset(i - 1, CPRJ_FCT) = objQTR(i).total_SALE
-            r.Offset(i - 1, CPRJ_BDG) = objQTR(i).total_BDGT
-            r.Offset(i - 1, CPRJ_CNT) = objQTR(i).total_LPU
-            r.Offset(i - 1, CPRJ_BEDS) = objQTR(i).total_REP
-            r.Offset(i - 1, CPRJ_HIR) = objQTR(i).total_HIR
-            r.Offset(i - 1, CPRJ_TER) = objQTR(i).total_TER
-            r.Offset(i - 1, CPRJ_CRD) = objQTR(i).total_ACS
-            If objQTR(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_BDG) = objQTR(i).total_SALE / objQTR(i).total_BDGT
-            End If
-            If objQTR(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_NMG) = objQTR(i).total_SALE / objQTR(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CPRJ_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_CLXN_NMG + 1)
-        End If
-    Next i
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Public Sub cbxPRJ_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_PRJ
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_PRJ
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_PRJ
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = PRJ_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CPRJ_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "PRJ_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btPRJ_QTR_Do_IT ' old btRM_OTR_DO_IT
-End Sub
-
-<<<<<<
-======================
-RM_LIST
->>>>>>
-Attribute VB_Name = "RM_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentRM_ID() As Long
-    Dim r As Range
-
-    With Worksheets("RM_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CRM_ID)
-    End With
-
-    getCurrentRM_ID = r
-End Function
-
-Public Sub RM_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("PM_CHR_IDX")
-        Case 1
-            Rm_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rm_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rm_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-
-        Case 4
-            Rm_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectRM_QTR(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "RM_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("RM_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Public Sub SelectREP_LIST(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "REP_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .setEnt_date (getEnt_date())
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateRMList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Sub UpdateRMList()
-    Dim rmcd() As tRMID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_RM_CommonList_by_QTR(rmcd(), ent_date)
-
-    With ThisWorkbook.Worksheets("RM_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rmcd)
-            r.Offset(i - 1, CRM_NAME) = GetRegionName(rmcd(i).rm.Region)
-            r.Offset(i - 1, CRM_ID) = rmcd(i).rm.rm_id
-            r.Offset(i - 1, CRM_BEDS) = rmcd(i).rgcd(1).total_BEDS
-            r.Offset(i - 1, CRM_BDGT) = rmcd(i).rgcd(1).total_BDGT
-            r.Offset(i - 1, CRM_NMG) = rmcd(i).rgcd(1).total_BDGT_NMG
-            r.Offset(i - 1, CRM_HIR) = rmcd(i).rgcd(1).total_HIR
-            r.Offset(i - 1, CRM_TER) = rmcd(i).rgcd(1).total_TER
-            r.Offset(i - 1, CRM_CAR) = rmcd(i).rgcd(1).total_ACS
-            r.Offset(i - 1, CRM_FACT) = rmcd(i).rgcd(1).total_SALE
-            r.Offset(i - 1, CRM_PLAN) = rmcd(i).rgcd(1).sale_PLAN
-            
-            With rmcd(i).rgcd(1)
-                r.Offset(i - 1, CRM_PAT_LPU) = .total_HIR + .total_TER + .total_ACS
-            End With
-            
-            r.Offset(i - 1, CRM_BDGT_1) = rmcd(i).rgcd(1).total_BDGT
-            If rmcd(i).rgcd(1).total_BDGT > 0 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = rmcd(i).rgcd(1).total_SALE / rmcd(i).rgcd(1).total_BDGT
-            End If
-            If r.Offset(i - 1, CRM_BDGT_1 + 1) > 1 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CRM_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CRM_AREA).row, CRM_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CRM_AREA).Column
-
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CRM_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CRM_NAME
-        Range("JUMP") = ""
-    Else
-        btRM_LIST_DO_IT
-    End If
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-<<<<<<
-======================
-mPRJ_QTR
->>>>>>
-Attribute VB_Name = "mPRJ_QTR"
-Sub btPRJ_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("PRJ_ACTION")
-    ent_date = Worksheets(PRJ_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            cmDataImport
-        Case 2
-            Worksheets("RM_LIST").setEnt_date (Worksheets("PRJ_QTR").getEnt_date())
-            Worksheets("RM_LIST").Range("ret_addr") = "PRJ_QTR"
-            Worksheets("RM_LIST").Select
-        Case 3
-            cmNewReport
-    End Select
-    Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-End Sub
-
-
-<<<<<<
-======================
-mRM_LIST
->>>>>>
-Attribute VB_Name = "mRM_LIST"
-Option Explicit
-
-Public Const CRM_AREA As String = "B12"
-Public Const CRM_NAME As Integer = 0
-Public Const CRM_NAME1 As Integer = 1
-Public Const CRM_NAME2 As Integer = 2
-Public Const CRM_ID As Integer = 3
-Public Const CRM_BEDS As Integer = 4
-Public Const CRM_BDGT As Integer = 5
-Public Const CRM_NMG As Integer = 6
-Public Const CRM_HIR As Integer = 7
-Public Const CRM_TER As Integer = 8
-Public Const CRM_CAR As Integer = 9
-Public Const CRM_FACT As Integer = 10
-Public Const CRM_PLAN As Integer = 11
-Public Const CRM_PAT_LPU As Integer = 16
-Public Const CRM_BDGT_1 As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(CRM As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_LIST")
-        s = "�������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub Rm_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub Rm_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CRM_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub btRM_LIST_RET_IT()
-    With Worksheets("RM_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "PRJ_QTR"
-    End With
-    ThisWorkbook.Worksheets("PRJ_QTR").Activate
-End Sub
-
-
-Sub btRM_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rm_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("RM_LIST_ACTION")
-    With Worksheets("RM_LIST")
-        rm_id = .getCurrentRM_ID()
-        
-        Select Case i
-            Case 1:
-                .SelectRM_QTR rm_id
-            Case 2:
-                .SelectREP_LIST rm_id
-            End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mImport2
->>>>>>
-Attribute VB_Name = "mImport2"
-Option Explicit
-
-Sub FOpen()
-    Dim flist As String
-    Dim fileToOpen, s
-    flist = ""
-    fileToOpen = Application _
-        .GetOpenFileName("Data Files (*.mdb), mr*.mdb", Title:="������ ������", MultiSelect:=True)
-    If fileToOpen <> False Then
-        For Each s In fileToOpen
-            flist = flist & s & "; "
-        Next s
-        MsgBox "Open " & flist
-    End If
-End Sub
-
-Sub t2()
-Dim d As ImprtDB
-Set d = New ImprtDB
-d.Show
-
-End Sub
-
-<<<<<<
-======================
-ImprtDB
->>>>>>
-Attribute VB_Name = "ImprtDB"
-Attribute VB_Base = "0{67FA6A28-8370-4981-8F01-1A9079245761}{ECFCB43F-B241-4CD9-9CB3-2A981933173D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-  "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-  lStructSize As Long
-  hWndOwner As Long
-  hInstance As Long
-  lpstrFilter As String
-  lpstrCustomFilter As String
-  nMaxCustFilter As Long
-  nFilterIndex As Long
-  lpstrFile As String
-  nMaxFile As Long
-  lpstrFileTitle As String
-  nMaxFileTitle As Long
-  lpstrInitialDir As String
-  lpstrTitle As String
-  flags As Long
-  nFileOffset As Integer
-  nFileExtension As Integer
-  lpstrDefExt As String
-  lCustData As Long
-  lpfnHook As Long
-  lpTemplateName As String
-End Type
-
-Private Sub Command1_Click()
-  Dim OpenFile As OPENFILENAME
-  Dim lReturn As Long
-  Dim sFilter As String
-  OpenFile.lStructSize = Len(OpenFile)
-'         OpenFile.hwndOwner = Form1.hWnd
-'         OpenFile.hInstance = App.hInstance
-  sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-  OpenFile.lpstrFilter = sFilter
-  OpenFile.nFilterIndex = 1
-  OpenFile.lpstrFile = String(257, 0)
-  OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-  OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-  OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-' OpenFile.lpstrInitialDir = "C:\"
-  OpenFile.lpstrTitle = "������ ������"
-  OpenFile.flags = OFN_HIDEREADONLY + OFN_ALLOWMULTISELECT + OFN_EXPLORER
-  lReturn = GetOpenFileName(OpenFile)
-  If lReturn = 0 Then
-     MsgBox "The User pressed the Cancel Button"
-  Else
-     MsgBox "The user Chose " & Trim(OpenFile.lpstrFile)
-  End If
-End Sub
-
-<<<<<<
-Project Name : 'ClexaneRM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).ClearRMName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "version 1.3"
-Public Const PROGRAM_FILENAME As String = "clexane-rm"
-Public Const PROGRAM_BACKUPNAME As String = "rm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "rm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "mr-ex-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{F2A5159C-AEB6-4066-B85F-339184DAFECD}{712D78F6-CCB6-499E-9674-B992A7482317}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{5D2CB2D2-3E5E-4B6E-9E0C-2EEBA5E10E17}{C891C133-B6B4-43D3-B411-B4A821905C23}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Boolean
-        Dim sum As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BB60E38F-A4AB-4AB4-91D0-40AA798D9F5C}{BE9A54D9-F093-4755-9E17-0B47BB5E2546}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{2C69E842-8DA9-4240-A0A8-F6B0141DC246}{75AAB28C-ADCF-4D1B-9D5A-AF89E80A810C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{BA873669-5C2D-400A-8A8B-572ACD8CCE4C}{D11400A0-9912-4240-A78C-44C33731216A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSet_REGMAN_Record
-    With Worksheets("RM_QTR")
-        .ClearRMName
-        .Range("REP_QTR_INPUT_DATA").ClearContents ' ��� �� ������, �������� ���������
-'        .Range("A1").Select
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-    
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-
-
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Sub ReSetREPRecord()
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbReSetREPRecord dbConnection
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-'Public Sub dbReSetREPRecord(dbConnection As Object)
-'
-'    Dim DeleteSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-       End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmImport()
-    Worksheets(RM_QTR_SHEET).Select
-    ImportData
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("RM_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    End If
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{3EA3C15A-5493-445F-9858-2F241E7D6CEA}{849C1FE1-631A-485D-BE54-A7B73124582C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{B85FF7F1-50C0-4433-BC6F-8A0F2C9BDDDA}{EC2D2B9E-9ED2-4005-A1E9-EF0626D3B7E7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    
-    Unprotect
-    
-    On Error Resume Next
-    
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{EC96F2D1-337D-47DF-B0F1-A6DF3F8CD5CC}{7EB42A63-CBFC-45B0-AE4D-C3E3D8FE7420}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{7B669454-C2AA-4FDF-8311-7ADEDDEF3FF3}{D07A0A02-4923-46C8-8EE8-62769243087D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetLastQTR_fromDB & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRMName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-End Sub
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSet_REGMAN_Record()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSet_REGMAN_Record dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-Public Sub dbReSet_REGMAN_Record(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-End Sub
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� �������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{D5892870-2C88-40C8-A817-AC9B1CF37C2C}{9853EBEA-4E48-41F9-89C0-6F753EB6A0C2}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            ImportData
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub ImportData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        If i > 0 Then
-            Merge_BackUp_All_Data
-            MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-        End If
-    End If
-    Worksheets(RM_QTR_SHEET).update_history
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-Project Name : 'ClexaneMR'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).ClearRepName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(REP_QTR_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-Const CQTR_PAT_ALL As Integer = 16
-Const CQTR_BDGT_ALL As Integer = 17
-
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRepName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-    Range("H5") = ""
-End Sub
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREP
-    
-    cRep = GetREPRecord
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-    
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    i = GetAll_QTR_Records(objQTR, "%")
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList(qcd)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_plan
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_BBL_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-
-Private Sub Worksheet_Activate()
-  
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-    
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CRow_Width Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-    
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub DO_New_qtr()
-    Dim res As Variant
-    Dim objQTR As tQTR
-    Dim s As String
-    s = GetLastQtr
-    objQTR.entry_date = GetNextQTR(s)
-    
-    If objQTR.entry_date = "" Then
-        Exit Sub
-    End If
-    
-    DO_Price_qtr objQTR.entry_date
-
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        Dim qtr As tQTR
-        Dim res As Integer
-        
-        qtr = Get_QTR_Record(ent_date)
-        
-        If qtr.id = 0 Then
-            qtr.entry_date = ent_date
-    
-            With Worksheets(VAR_SHEET)
-                qtr.ClxnH20mg = .Range("ClxnH20mg")
-                qtr.ClxnH40mg = .Range("ClxnH40mg")
-                qtr.ClxnT40mg = .Range("ClxnT40mg")
-                qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-                qtr.ClxnC_IM = .Range("ClxnC_IM")
-            End With
-        End If
-        
-        Dim dlg_nq As dlg_nextQTR
-        Set dlg_nq = New dlg_nextQTR
-        
-        With dlg_nq
-            .tb_qtr_name = qtr.entry_date
-            .tb_bdgt_avts = qtr.sale_plan
-            .tb_qtr_name = qtr.entry_date
-            .tb_ClxnH20mg = qtr.ClxnH20mg
-            .tb_ClxnH40mg = qtr.ClxnH40mg
-            .tb_ClxnT40mg = qtr.ClxnT40mg
-            .tb_ClxnC_ACS = qtr.ClxnC_ACS
-            .tb_ClxnC_IM = qtr.ClxnC_IM
-        End With
-        
-        dlg_nq.Show
-        res = dlg_nq.Tag
-        
-        If res = vbOK Then
-            With dlg_nq
-                If Not IsNumeric(.tb_bdgt_avts) Then
-                    MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                Else
-                    If .tb_bdgt_avts = 0 Then
-                        MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                        Exit Sub
-                    End If
-                End If
-                Dim bool As Boolean
-                bool = IsNumeric(.tb_ClxnH20mg) _
-                    And IsNumeric(.tb_ClxnH40mg) _
-                    And IsNumeric(.tb_ClxnT40mg) _
-                    And IsNumeric(.tb_ClxnC_ACS) _
-                    And IsNumeric(.tb_ClxnC_IM)
-                If Not bool Then
-                    MsgBox "������� ��������� �����", vbOK, PROGRAM_NAME
-                    Exit Sub
-                End If
-                qtr.sale_plan = .tb_bdgt_avts
-                qtr.entry_date = .tb_qtr_name
-                qtr.ClxnH20mg = .tb_ClxnH20mg
-                qtr.ClxnH40mg = .tb_ClxnH40mg
-                qtr.ClxnT40mg = .tb_ClxnT40mg
-                qtr.ClxnC_ACS = .tb_ClxnC_ACS
-                qtr.ClxnC_IM = .tb_ClxnC_IM
-            End With
-            Insert_QTR_Record qtr
-        End If
-    End If
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = False
-            .Range("ent_date") = ent_date
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        Dim i As Integer
-        i = MsgBox("������� ������ �� ������ [" & ent_date & "]?", vbDefaultButton2 + vbOKCancel, PROGRAM_NAME)
-        If i = vbOK Then
-            Dim objQTR As tQTR
-            If ent_date <> "" Then
-                objQTR.entry_date = ent_date
-                objQTR = Get_QTR_Record(ent_date)
-                Delete_QTR_Record objQTR
-                Worksheets(TITLE_SHEET).Select
-                Worksheets(REP_QTR_SHEET).Select
-            End If
-        End If
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            DO_New_qtr
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            dbExport
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    End Select
-    If idx <> 2 Then
-        With ThisWorkbook
-            .Worksheets(TITLE_SHEET).Select
-            .Worksheets(REP_QTR_SHEET).Select
-        End With
-    End If
-End Sub
-
-Sub Delete_qtr()
-    Dim ent_date As String
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    DO_Delete_qtr ent_date
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[MR]"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-    
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-    
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-        
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-                   
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-       
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CINP_WIDTH Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-    
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-        
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    lpu_id = r
-    
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-    
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-    
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-            
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-        
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-        
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-        
-        Case Else
-            Range("JUMP") = ""
-    End Select
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-    
-    is_input_range = INPUT_NO
-    
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-    
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREP
-    
-    ' ent_date = "%" ' % - all records
-    ent_date = getEnt_date
-    
-    objQTR = Get_QTR_Record(ent_date)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-     
-    ' ������� ���
-    Range("C3:C4").ClearContents
-    cRep = GetREPRecord
-    
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_plan
-    
-
-    
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-        
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-            
-         
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_plan
-            
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-            
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{566B33D6-957A-43E4-8444-D8EA3889700C}{42EE65B8-F8C6-4F95-9F52-7738BF6FCEAD}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-    
-        Dim objHir As tHIRURGIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.Count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-        
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-    
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-            Application.ScreenUpdating = False
-            
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-            
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{EBA94131-180E-4709-A2A3-B60D48987620}{47A860A1-BF92-4EBB-A333-AB7E83FAB868}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_plan = Round(Range("F13").Value, 0)
-            
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_plan
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_plan <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("��������� ������� ��������?", vbYesNo, PROGRAM_NAME) Then
-                    Insert_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-    
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_plan
-    
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    objQTR = Get_QTR_Record(ent_date)
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-    
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-        
-        SetupData cLPU
-        
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case INPUT_CHECK
-            
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{E3F10C5A-A4B4-42FF-A2C9-6F8198210A07}{563D0F3D-F79D-48F1-AFE4-A2136809B982}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{137EDDE5-3DB4-4BAD-A245-324DC31ABB36}{3BD7159A-BF6C-403F-B3DF-4834FA9E4D92}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{8EB80D4C-3476-421A-A370-6332A07DE509}{A7542905-C9F8-4F39-AD67-B62A88F8F4E6}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREP
->>>>>>
-Attribute VB_Name = "mREP"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSetREPRecord
-    With Worksheets("REP_QTR")
-        .ClearRepName
-        .Range("REP_QTR_INPUT_DATA").ClearContents
-        .Range("QTR_SEL") = ""
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-        Worksheets("REP_QTR").Range("QTR_SEL") = ""
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cUser As tREP
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cUser = GetREPRecord()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cUser.Region
-        .Range("IDX_CITY") = cUser.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cUser.Region
-        .cbCity = cUser.City
-        .tbFName = cUser.FirstName
-        .tbLName = cUser.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cUser
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        SetREPRecord cUser
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_plan As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim SQL As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_plan = 0
-    End With
-        
-    
-    SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_plan = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_plan = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_plan
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_plan & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPU(allLPU() As tLPU) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPU = dbGetAllLPU(dbConnection, allLPU)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPUbyQTR(allLPU() As tLPU, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPUbyQTR = dbGetAllLPUbyQTR(dbConnection, allLPU, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objLPU.id = 0 then insert else update
-Sub Insert_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    If objLPU.id = 0 Then
-        dbInsert_LPU_Record dbConnection, objLPU
-    Else
-        dbUpdate_LPU_Record dbConnection, objLPU
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub Delete_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDelete_LPU_Record dbConnection, objLPU
-    dbCloseConnection dbConnection
-End Sub
-
-Sub Delete_LPU_RecordQTR(ByRef objLPU As tLPU, ent_date As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-    dbCloseConnection dbConnection
-    
-End Sub
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim SQL As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    SQL = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Sub dbInsert_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-  
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu", dbConnection, 2, 2
-    dbRecordset.addnew
-    dbRecordset("name") = objLPU.name
-    dbRecordset("address") = objLPU.address
-    dbRecordset("rep_id") = objLPU.rep_id
-    dbRecordset("beds") = objLPU.beds
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objLPU.id = dbRecordset("id")
-  
-End Sub
-
-Sub dbUpdate_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu SET " & _
-    "name='" & objLPU.name & "'," & _
-    "address='" & objLPU.address & "'," & _
-    "beds=" & objLPU.beds & "," & _
-    "rep_id=" & objLPU.rep_id& & _
-    " WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-
-Function dbGetAllLPU(dbConnection As Object, allLPU() As tLPU) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu"
-    getAll_LPU_SQL = "SELECT * FROM lpu"
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPU = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAllLPUbyQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim where As String
-    where = "WHERE lpu_budget.entry_date like '" & ent_date & "'"
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget " & where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & where & " AND lpu.id=lpu_budget.lpu_id"
-    
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPUbyQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Sub dbDelete_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu " & _
-    "WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Hir_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Ter_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_ACS_RecordsByLPU_ID dbConnection, objLPU.id
-    
-End Sub
-
-Sub dbDelete_LPU_RecordQTR(dbConnection As Object, ByRef objLPU As tLPU, ent_date As String)
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-End Sub
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-Option Explicit
-
-Public Type tREP
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetREPRecord() As tREP
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetREPRecord = dbGetREPRecord(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub SetREPRecord(cUser As tREP)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSetREPRecord dbConnection, cUser
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSetREPRecord()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSetREPRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGetREPRecord(dbConnection As Object) As tREP
-    
-    Dim SQL As String
-    Dim objREP As tREP
-    
-    objREP.FirstName = ""
-    objREP.LastName = ""
-    objREP.Region = 0
-    objREP.City = 0
-    SQL = "SELECT firstname, lastname, region, city FROM " & _
-          "rep"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREP.FirstName = dbRecordset("firstname")
-        objREP.LastName = dbRecordset("lastname")
-        objREP.Region = dbRecordset("region")
-        objREP.City = dbRecordset("city")
-        
-    End If
-    
-    dbGetREPRecord = objREP
-        
-End Function
-
-Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREP.FirstName & "', " & _
-    "'" & objREP.LastName & "', " & _
-    objREP.Region & ", " & _
-    objREP.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-End Sub
-
-Public Sub dbReSetREPRecord(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("REP_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-'                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = Double2Str(.risk_percent, 3)
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub test()
-    Dim s As String
-    Dim d As Single
-    d = 1235.6789
-    s = Format(d, "####0,00")
-    MsgBox s
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    Dim del_request As Integer
-    Dim allLPU() As tLPU
-    Dim lpu_count As Integer
-    Dim i As Integer
-    Dim tmp_LPU_List As Range
-    Dim tmp_LPU_List_Addr As String
-    Dim r_end As Range
-    Dim dlg As Dlg_lpu_card
-    
-    Set dlg = New Dlg_lpu_card
-    
-    lpu_count = GetAllLPU(allLPU)
-    With Worksheets(VAR_SHEET)
-        Set tmp_LPU_List = .Range("tmp_LPU_List")
-        Set r_end = .Range(tmp_LPU_List, tmp_LPU_List.End(xlDown))
-        Set r_end = .Range(r_end, r_end.End(xlToRight))
-        .Range(tmp_LPU_List, r_end).ClearContents
-    End With
-        
-    If lpu_count <> 0 Then
-        dlg.cbxLPU_List_Enable.Enabled = True
-        For i = 1 To UBound(allLPU)
-            tmp_LPU_List.Cells(i, 1) = allLPU(i).name
-            tmp_LPU_List.Cells(i, 2) = allLPU(i).address
-            tmp_LPU_List.Cells(i, 3) = allLPU(i).beds
-            tmp_LPU_List.Cells(i, 4) = allLPU(i).id
-        Next i
-    Else
-        dlg.cbxLPU_List_Enable.Enabled = False
-    End If
-    
-    tmp_LPU_List_Addr = Worksheets(VAR_SHEET).name & "!" & _
-            Worksheets(VAR_SHEET).Range(tmp_LPU_List, tmp_LPU_List.End(xlDown)).address
-
-    With dlg
-        .cbLPU_List.RowSource = tmp_LPU_List_Addr
-        .cbLPU_List.ListIndex = 0
-        .cbxLPU_List_Enable = False
-        .cbLPU_List.Enabled = False
-        If cLPU.id <> 0 Then
-            .cbxLPU_List_Enable.Enabled = False
-        Else
-            If lpu_count <> 0 Then
-                .cbxLPU_List_Enable.Enabled = True
-            Else
-                .cbxLPU_List_Enable.Enabled = False
-            End If
-        End If
-        .tb_lpu_name.Text = cLPU.name
-        .tb_lpu_address.Text = cLPU.address
-        .tbBedsCount = cLPU.beds
-
-        .Tag = vbCancel
-    End With
-    
-    dlg.Show
-    
-    If Not IsNumeric(dlg.Tag) Then
-        Exit Sub
-    End If
-    
-    If dlg.Tag = vbOK Then
-        Dim n As Variant
-        Dim test As Integer
-        test = 0
-        n = dlg.tbBedsCount.Value
-        If Not IsNumeric(n) Then
-            test = 1
-        Else
-            If n = 0 Then
-                test = 1
-            End If
-        End If
-        If test = 0 Then
-            
-            cLPU.name = dlg.tb_lpu_name.Text
-            cLPU.address = dlg.tb_lpu_address.Text
-            cLPU.beds = dlg.tbBedsCount.Value
-                                    
-            If cLPU.name = "" Or cLPU.address = "" Then
-                test = 2
-            End If
-        End If
-        Select Case test
-            Case 0
-                If dlg.cbxLPU_List_Enable.Value = True Then
-                    cLPU.id = tmp_LPU_List.Cells(dlg.cbLPU_List.ListIndex + 1, 4)
-                End If
-                Insert_LPU_Record cLPU
-                ' ��������� ������� ������ ��� ��� � ��������
-                Dim bdgt As tBUDGET
-                bdgt = Get_BDGT_Record(cLPU.id, ent_date)
-                ' ������ ���: ������� ������ ������ � lpu_budget
-                If bdgt.id = 0 Then
-                    bdgt.lpu_id = cLPU.id
-                    bdgt.entry_date = ent_date
-                    Insert_BDGT_Record bdgt
-                End If
-            Case 1
-                MsgBox "������� ��������� ���������� ������ ����� ��� 1!", vbOKOnly, PROGRAM_NAME
-            Case 2
-                MsgBox "������������ � ����� ��� �� ������ ���� �������!", vbOKOnly, PROGRAM_NAME
-        End Select
-    End If
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-    
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-    
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-    
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & "."
-        .Show
-        
-        If .Tag = vbOK Then
-            If .chbDeleteAll.Value Then
-                delete_all = _
-                    MsgBox("��� ������ �� ��� � ������ '" & cLPU.name & _
-                    "' ����� ������� ��������.", vbOK, PROGRAM_NAME)
-                If delete_all = vbOK Then
-                    Delete_LPU_Record cLPU
-                End If
-            Else
-                Delete_LPU_RecordQTR cLPU, ent_date
-            End If
-        End If
-    End With
-    
-    With ThisWorkbook
-        .Worksheets(TITLE_SHEET).Select
-        .Worksheets("LPU_LIST").Select
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Activate
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-        
-    
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id <> 0 And i = 1 Then
-            lpu_id = 0
-        End If
-        If lpu_id = 0 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1, 6
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                If lpu_id <> 0 Then
-                    .SelectLPU_BDGT lpu_id, ent_date
-                    .Range("JUMP") = "LPU_BDGT"
-                End If
-            Case 3
-                If lpu_id <> 0 Then
-                    .SelectLPU_HIR lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_HIR"
-                End If
-            Case 4
-                If lpu_id <> 0 Then
-                    .SelectLPU_TER lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_TER"
-                End If
-            Case 5
-                If lpu_id <> 0 Then
-                    .SelectLPU_C_ACS lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_C_ACS"
-                End If
-        End Select
-    End With
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_plan As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    Else
-        getLast_QTR_SQL = ""
-    End If
-    
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Sub Insert_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTR.id <> 0 Then
-        dbUpdate_QTR_Record dbConnection, objQTR
-    Else
-        dbInsert_QTR_Record dbConnection, objQTR
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTR_Record(ent_date As String) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, ent_date)
-    If i <> 0 Then
-        Get_QTR_Record = allQTR(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records(ByRef All_QTR() As tQTR, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTR_Records = dbGetAll_QTR_Records(dbConnection, All_QTR, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTR_Record dbConnection, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTR.ID <> 0 then updatre else insert
-Sub dbInsert_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTR
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_plan
-        dbRecordset("rep_id") = .rep_id
-        dbRecordset("ClxnH20mg") = .ClxnH20mg
-        dbRecordset("ClxnH40mg") = .ClxnH40mg
-        dbRecordset("ClxnT40mg") = .ClxnT40mg
-        dbRecordset("ClxnC_IM") = .ClxnC_IM
-        dbRecordset("ClxnC_ACS") = .ClxnC_ACS
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTR.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim Update_SQL As String
-    
-    With objQTR
-        Update_SQL = "UPDATE quarter SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rep_id=" & .rep_id & "," & _
-            "sale_plan=" & .sale_plan & "," & _
-            "ClxnH20mg=" & .ClxnH20mg & "," & _
-            "ClxnH40mg=" & .ClxnH40mg & "," & _
-            "ClxnT40mg=" & .ClxnT40mg & "," & _
-            "ClxnC_IM=" & .ClxnC_IM & "," & _
-            "ClxnC_ACS=" & .ClxnC_ACS & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTR_Records(dbConnection As Object, All_QTR() As tQTR, ent_date As String) As Integer
-    
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter WHERE entry_date like '" & ent_date & "'"
-    getAll_QTR_SQL = "SELECT * FROM quarter WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTR_Records = QTR_Count
-    
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim All_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_plan = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 All_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter " & _
-    "WHERE id=" & objQTR.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Hir_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Ter_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_ACS_RecordsByQTR dbConnection, objQTR.entry_date
-       
-End Sub
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList(ByRef qcd() As tQTR_COMMON) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList = dbGet_QTR_CommonList(dbConnection, qcd)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList(dbConnection As Object, ByRef qcd() As tQTR_COMMON) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, "%")
-    dbGet_QTR_CommonList = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_plan
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    On Error GoTo l_exit
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-l_exit:
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-        .EditDirectlyInCell = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{2FC04B4C-EB99-433E-ACDB-A920D02B9B5B}{777B85CC-ADE3-4188-94C8-9E07DA8B5076}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    On Error GoTo ExitLabel
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.Count
-                On Error Resume Next
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{3F7D7D75-90F6-4829-9E24-CA5391BB2A03}{A1A0F296-0D28-4123-8E38-82FA6EE6F2EF}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAllLPUbyQTR(dbConnection, allLPU, objQTR.entry_date)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-   
-    Unprotect
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-        
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{91AE5FA0-01C7-4C10-9E5F-D1D2DDF29401}{5726592A-BC0A-4E79-A963-35D354045716}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{FB055133-927F-41FF-BC90-442833A40591}{11BCAB43-1EDD-440B-AB0E-20CD6E42E11A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tID_REP
-    id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Public Type tID_REP_COMMON
-    id_rep As tID_REP
-    i_qtr As Long
-    qtrs As tQTR_COMMON
-End Type
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim last_qtr As String
-    
-    On Error GoTo ErrHandler
-    
-    last_qtr = GetLastQTR_fromDB
-    If last_qtr = "" Then
-        MsgBox "��� ������� � ���� ������. ������� ����������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & last_qtr & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub t()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-    xlRestoreView
-End Sub
-
-Sub xlRestoreView()
-    Application.CommandBars("Standard").Visible = True
-    Application.CommandBars("Formatting").Visible = True
-    Application.DisplayFormulaBar = True
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Function GetRegion(idx As Integer) As String
-    GetRegion = Range("LST_REGIONS").Offset(i, 0)
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    Call CleanUp
-End Sub
-
-Private Sub Workbook_Open()
-    Call CreateFormBar
-    frmFaceID.Show
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-'Global variables hold preious choices
-'for begining and ending FaceID numbers
-Public glbLastFirstID As Long
-Public glbLastLastID As Long
-
-
-Function CBShowButtonFaceIDs(lngIDStart As Long, _
-                             lngIDStop As Long)
-    ' This procedure creates a toolbar with buttons that display the
-    ' images associated with the values starting at lngIDStart and
-    ' ending at lngIDStop.
-    
-    Dim cbrNewToolbar   As CommandBar
-    Dim cmdNewButton    As CommandBarButton
-    Dim intCntr         As Integer
-    
-    ' Delete existing ShowFaceIds toolbar if it exists.
-    On Error Resume Next
-    Application.CommandBars("ShowFaceIds").Delete
-    frmFaceID.MousePointer = fmMousePointerHourGlass
-    ' Create a new toolbar.
-    Set cbrNewToolbar = Application.CommandBars.Add _
-        (Name:="ShowFaceIds", temporary:=True)
-    
-    ' Create a new button with an image matching the FaceId property value
-    ' indicated by intCntr.
-    For intCntr = lngIDStart To lngIDStop
-        Set cmdNewButton = cbrNewToolbar.Controls.Add(Type:=msoControlButton)
-        With cmdNewButton
-            ' Setting the FaceId property value specifies the appearance
-            ' but not the functionality of the button.
-            .FaceId = intCntr
-            .Caption = "FaceId = " & intCntr
-        End With
-    Next intCntr
-    
-    ' Show the images on the toolbar.
-    With cbrNewToolbar
-        .Width = 600
-        .Left = 100
-        .Top = 200
-        .Visible = True
-    End With
-    frmFaceID.MousePointer = fmMousePointerDefault
-End Function
-
-
-
-Public Function Validate()
-Dim lngTempNumber As Long
-
-'Procedure to check data entered by user
-With frmFaceID
-'If the first number requested < last number
-'then reverse them and rationalize
-'display next time form opens
-    If .txtFirstID Or .txtLastID > 0 Then
-        If CLng(.txtFirstID) > CLng(.txtLastID) Then
-           lngTempNumber = .txtFirstID
-           .txtFirstID = .txtLastID
-           .txtLastID = lngTempNumber
-         glbLastFirstID = .txtFirstID
-         glbLastLastID = .txtLastID
-        End If
- 'Only allow 200 FaceIDs per operation
- 'Call procedure to create FaceID values
- 'Take form out of memory
- 
-        If (.txtLastID - .txtFirstID) <= 200 Then
-            Call CBShowButtonFaceIDs(.txtFirstID, .txtLastID)
-            Unload frmFaceID
-        Else
-            MsgBox "Please request less than 200 FaceID's ", , "FaceID Number Finder"
-        End If
-    Else
-            .txtFirstID.SetFocus
-    End If
-End With
-End Function
-
-Public Function CleanUp()
-    On Error Resume Next
-   
-    Application.CommandBars("ShowFaceIds").Delete
-    Application.CommandBars("ShowForm").Delete
-      
-        
-End Function
-
-Public Function CreateFormBar()
-    Dim cmdBar As CommandBar
-    Dim btnForm As CommandBarButton
-'Delete the object if it already exists
-    On Error Resume Next
-    Application.CommandBars("ShowForm").Delete
-'Set the commandbar object variable
-    Set cmdBar = Application.CommandBars.Add
-        cmdBar.Name = "ShowForm"
-'Add a button
-    With cmdBar.Controls
-        
-        Set btnForm = .Add(msoControlButton)
-        
-    End With
-'Set the new button's properties
-    With btnForm
-        .Style = msoButtonIconAndCaption
-        .Caption = "Show FaceId Finder Form"
-        .FaceId = 2104
-        .OnAction = "OpenForm"
-        .TooltipText = "Show FaceID Form"
-    End With
-  ' Made visible in the form terminate event
-
-End Function
-
-Public Function OpenForm()
-'OnAction event procedure of ShowForm toolbar
-    frmFaceID.Show
-End Function
-
-
-<<<<<<
-======================
-frmFaceID
->>>>>>
-Attribute VB_Name = "frmFaceID"
-Attribute VB_Base = "0{5F1D3654-0CF0-11D2-B619-00AA00BBB974}{5F1D3641-0CF0-11D2-B619-00AA00BBB974}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub cmdFaceId_Click()
-  
-  Dim strDefaultStatus As String
- 'Set up global variables with current requested values
-    glbLastFirstID = txtFirstID
-    glbLastLastID = txtLastID
- 'Detect current status bar value
- 'Set status bar message while FaceId's are generated
-    strDefaultStatus = Application.DisplayStatusBar
-    Application.DisplayStatusBar = True
-    Application.StatusBar = "Working on FaceID display please wait"
-    
-'Call validation procedure
-   
-    Call Validate
- 'Put Status bar back as it was
-    Application.DisplayStatusBar = False
-    Application.StatusBar = strDefaultStatus
-End Sub
-
-
-Private Sub txtFirstID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
-   'Test for non numeric entry then cancel or convert to long
-    If IsNumeric(txtFirstID) = False Then
-       txtFirstID = ""
-       Cancel = True
-    Else
-        txtFirstID = CLng(txtFirstID)
-    End If
-    
-End Sub
-
-
-Private Sub txtLastID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
-    'Test for non numeric entry then cancel or convert to long
-    If IsNumeric(txtLastID) = False Then
-       txtLastID = ""
-       Cancel = True
-    Else
-        txtLastID = CLng(txtLastID)
-    End If
-    
-End Sub
-
-Private Sub UserForm_Activate()
- 'Set up form with last requested values
- 'Make toolbar not visible
- On Error Resume Next
-    txtFirstID = glbLastFirstID
-    txtLastID = glbLastLastID
-    Application.CommandBars("ShowForm").Visible = False
-End Sub
-
-
-
-Private Sub UserForm_Terminate()
-    'Show toolbar if form is unloaded in
-    'Validate procedure of if X is clicked
-    Application.CommandBars("ShowForm").Visible = True
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Workbook_Activate()
-    Worksheets("Home").Select
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("C4:G30").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("D44:H59").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-PPExport
->>>>>>
-Attribute VB_Name = "PPExport"
-Option Explicit
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub ViewReport()
-    Dim ReportDoc As PowerPoint.Presentation
-    Set ReportDoc = GetObject(GetWBPath(ThisWorkbook.FullName) + "report.ppt")
-    ReportDoc.Application.Visible = True
-End Sub
-
-Sub CreateReportSlide(ReportDoc As PowerPoint.Presentation, Title As String)
-    Dim ReportPage As PowerPoint.Slide
-    
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.Count + 1, ppLayoutBlank)
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = Title
-End Sub
-
-Sub CreateReport()
-    Dim ReportApp As PowerPoint.Application
-    Dim ReportDoc As PowerPoint.Presentation
-    
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    Set ReportDoc = ReportApp.Presentations.Add
-    
-    Dim i As Integer
-    For i = 1 To 4
-        ThisWorkbook.Worksheets("Sheet" + Format(i)).ExportCopy
-        CreateReportSlide ReportDoc, "Create slide name #" + Format(i)
-    Next i
-    
-    ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + "report"
-    ReportApp.Quit
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Unprotect "password"
-    ThisWorkbook.Save
-End Sub
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Protect password:="password"
-    Worksheets("Calc").Protect password:="password", userInterfaceonly:=True
-    Worksheets("Calc").Select
-    Worksheets("Calc").Range("A7").Select
-End Sub
-<<<<<<
-======================
-Calc
->>>>>>
-Attribute VB_Name = "Calc"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Sub SelectAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOn
-        End If
-    Next Sh
-    Range("A7").Select
-End Sub
-
-Sub ClearAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOff
-        End If
-    Next Sh
-    Range("A7").Select
-    Worksheets("Data").Range("K2") = 1
-    Worksheets("Calc").Range("E58") = 1
-End Sub
-
-<<<<<<
-======================
-Data
->>>>>>
-Attribute VB_Name = "Data"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-GCircle
->>>>>>
-Attribute VB_Name = "GCircle"
-Const MIN_FLOAT As Double = 0.00001
-Const PI As Double = 3.14159265358979
-Const PI_div_2 As Double = PI / 2
-
-
-Function arctg(dx As Double, dy As Double) As Double
-        If Abs(dx) < MIN_FLOAT Then
-            If Abs(dy) < MIN_FLOAT Then
-                arctg = 0#
-            Else
-                If dy > 0# Then
-                    arctg = PI_div_2
-                Else
-                    arctg = 3# * PI_div_2
-                End If
-            End If
-        Else
-            If Abs(dy) < MIN_FLOAT Then
-                If dx > 0# Then
-                    arctg = 0#
-                Else
-                    arctg = PI
-                End If
-            Else
-                If dx > 0# Then
-                    If dy > 0# Then
-                        arctg = Atn(dy / dx)
-                    Else
-                        arctg = 2# * PI + Atn(dy / dx)
-                    End If
-                Else
-                    arctg = PI + Atn(dy / dx)
-                End If
-            End If
-        End If
-End Function
-
-
-Sub test_line()
-    Dim stp As Range
-    Dim wksname As Range
-    Dim wks As Worksheet
-    Dim r As Range
-    Dim st As Range
-    
-    Set wksname = Worksheets("~test").Range("WksList")
-    
-    ClearTable Worksheets("~test").Range("WksList").Offset(2, 0)
-    While wksname <> ""
-        Set stp = Worksheets("~test").Range("Steps")
-        Set wks = Worksheets(wksname.Value2)
-        Set r = wksname.Offset(2, 0)
-        While stp <> ""
-            wks.Range("Steps") = stp
-            wks.Select
-            makeData wks
-            Set st = wks.Range(wks.Range("Table")).Offset(-2, 5)
-            r.Offset(0, 0) = st / wks.Range("Ro")
-            r.Offset(0, 0).NumberFormat = "0.000%; [Red]-0.000%"
-            Set st = st.Offset(-1, 0)
-            r.Offset(0, 1) = Abs(st / wks.Range("Ro"))
-            r.Offset(0, 1).NumberFormat = st.NumberFormat
-            Set st = st.Offset(-1, 2)
-            r.Offset(0, 2) = st
-            r.Offset(0, 2).NumberFormat = st.NumberFormat
-            Set r = r.Offset(1, 0)
-            Set stp = stp.Offset(1, 0)
-        Wend
-        Set wksname = wksname.Offset(0, 3)
-    Wend
-    Worksheets("~test").Select
-End Sub
-
-Sub recalc_all()
-    Dim wks As Worksheet
-    Dim stp As Integer
-    stp = Worksheets("~common").Range("Steps")
-    For Each wks In Worksheets
-        If Left(wks.Name, 1) <> "~" Then
-            wks.Select
-            wks.Range("Steps") = stp
-            makeData wks
-        End If
-    Next wks
-    Worksheets("~common").Select
-    make_common
-End Sub
-
-Sub make_common()
-    Dim wks As Worksheet
-    Dim r As Range
-    Dim st As Range
-    Worksheets("~common").Select
-    Set r = Range(Range("Table"))
-    ClearTable r
-    For Each wks In Worksheets
-        If Left(wks.Name, 1) <> "~" Then
-            r = wks.Name
-            ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:= _
-            "'" & wks.Name & "'!A1", TextToDisplay:=wks.Name
-
-            r.Offset(0, 1) = wks.Range("Segs")
-            r.Offset(0, 2) = wks.Range("Steps")
-            Set st = wks.Range(wks.Range("Table")).Offset(-5, 5)
-            For i = 0 To 3
-                r.Offset(0, 3 + i) = st.Offset(i, 0)
-                r.Offset(0, 3 + i).NumberFormat = st.Offset(i, 0).NumberFormat
-            Next i
-            For i = 0 To 3
-                r.Offset(0, 7 + i) = st.Offset(i, 3)
-                r.Offset(0, 7 + i).NumberFormat = st.Offset(i, 3).NumberFormat
-            Next i
-            For i = 2 To 3
-                r.Offset(0, 9 + i) = st.Offset(i, 5)
-                r.Offset(0, 9 + i).NumberFormat = st.Offset(i, 5).NumberFormat
-            Next i
-            
-            Set r = r.Offset(1, 0)
-            
-        End If
-    Next wks
-    Range("B4").Select
-    Range(Selection, Selection.End(xlToRight)).Select
-    Range(Selection, Selection.End(xlDown)).Select
-    Selection.Sort Key1:=Range("h5"), Order1:=xlAscending, Header:=xlGuess, _
-        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
-    Range("a1").Select
-
-End Sub
-
-Function GetCirclePoint(r As Range, T As Double) As Double
-    With ActiveSheet
-        Dim seg_count, seg_number As Integer
-        Dim ctrl As Range
-        seg_count = Range("Segs")
-        seg_number = 0
-        
-        Select Case seg_count
-            Case 1:
-                Set ctrl = r
-            Case 2:
-                If Abs(T - 1) < 0.000001 Then
-                    T = 1
-                    seg_number = 1
-                Else
-                    seg_number = Int(seg_count * T)
-                    T = T * seg_count - seg_number
-                End If
-                Set ctrl = r.Offset(seg_number * 2, 0)
-            Case 4:
-                If Abs(T - 1) < 0.000001 Then
-                    T = 1
-                    seg_number = 3
-                Else
-                    seg_number = Int(seg_count * T)
-                    T = T * seg_count - seg_number
-                End If
-                Select Case seg_number
-                    Case 0:
-                        Set ctrl = r
-                    Case 1:
-                        Set ctrl = r.Offset(0, 3)
-                    Case 2:
-                        Set ctrl = r.Offset(2, 0)
-                    Case 3:
-                        Set ctrl = r.Offset(2, 3)
-                End Select
-        End Select
-        
-        If seg_count > 1 Then
-        End If
-        GetCirclePoint = GetBezierPath(ctrl, T)
-    End With
-End Function
-
-Private Function GetBezierPath(r As Range, T As Double) As Double
-    Dim LAST_IDX As Integer
-    
-    LAST_IDX = r.Cells.Count
-    
-    Dim pnts() As Double
-    ReDim pnts(LAST_IDX)
-    
-    Dim i As Integer
-    Dim j As Integer
-    Dim k As Integer
-    For i = 1 To LAST_IDX
-        pnts(i) = r(i)
-    Next i
-    i = LAST_IDX
-    Do While i > 1
-        j = LAST_IDX
-        k = i
-        Do While k > 1
-            pnts(j) = pnts(j) * T + pnts(j - 1) * (1 - T)
-            j = j - 1
-            k = k - 1
-        Loop
-        i = i - 1
-    Loop
-    GetBezierPath = pnts(LAST_IDX)
-End Function
-
-Sub makeCircleData()
-    makeData ActiveSheet
-End Sub
-
-Sub ClearTable(r As Range)
-        r.Select
-        r.Worksheet.Range(Selection, Selection.End(xlToRight)).Select
-        r.Worksheet.Range(Selection, Selection.End(xlDown)).Select
-        Selection.ClearContents
-End Sub
-
-Sub makeData(wks As Worksheet)
-    With wks
-    
-        wks.EnableCalculation = False
-        
-        Dim cutoffs As Integer
-        Dim step_b, sb As Double
-        Dim step_g, sg As Double
-        Dim s As String
-        Dim rs As Range
-        Dim st As Range
-        Dim astep As Range
-                
-        cutoffs = wks.Range("Steps")
-        step_g = 360 / cutoffs
-        step_b = step_g / 360
-        
-        Set rs = wks.Range(wks.Range("Table"))
-        Set st = rs.Offset(-5, 5)
-        Set astep = wks.Range("A_Step")
-        
-        ClearTable rs
-    
-        sg = 0 + step_g
-        sb = 0 + step_b
-        For i = 1 To cutoffs
-            rs.Offset(0, 0) = sg
-            rs.Offset(0, 0).NumberFormat = "0.00"
-            rs.Offset(0, 1) = sb
-            rs.Offset(0, 1).NumberFormat = "0.000_ ;[Red]-0.000 "
-            
-            rs.Offset(0, 2).FormulaLocal = "=GetCirclePoint(Xs0;" + rs.Offset(0, 1).Address + ")"
-            rs.Offset(0, 2).NumberFormat = "0.000_ ;[Red]-0.000 "
-            
-            rs.Offset(0, 3).FormulaLocal = "=GetCirclePoint(Ys0;" + rs.Offset(0, 1).Address + ")"
-            rs.Offset(0, 3).NumberFormat = "0.000_ ;[Red]-0.000 "
-            
-            rs.Offset(0, 4).FormulaLocal = "=SQRT((Xo - " + rs.Offset(0, 2).Address + ")^2 + (Yo - " + rs.Offset(0, 3).Address + ")^2)"
-            rs.Offset(0, 4).NumberFormat = "0.000_ ;[Red]-0.000 "
-            
-            rs.Offset(0, 5).FormulaLocal = "=Ro - " + rs.Offset(0, 4).Address
-            rs.Offset(0, 5).NumberFormat = "0.000_ ;[Red]-0.000 "
-            
-            If i <> 1 Then
-                rs.Offset(0, 6).FormulaLocal = "=SQRT((" _
-                        + rs.Offset(0, 2).Address _
-                        + "-" _
-                        + rs.Offset(-1, 2).Address _
-                        + ")^2 + (" _
-                        + rs.Offset(0, 3).Address _
-                        + "-" _
-                        + rs.Offset(-1, 3).Address _
-                        + ")^2)"
-            Else
-                rs.Offset(0, 6).FormulaLocal = "=SQRT((" _
-                        + rs.Offset(0, 2).Address _
-                        + "-" _
-                        + rs.Offset(-2, 2).Address _
-                        + ")^2 + (" _
-                        + rs.Offset(0, 3).Address _
-                        + "-" _
-                        + rs.Offset(-2, 3).Address _
-                        + ")^2)"
-            End If
-            rs.Offset(0, 6).NumberFormat = "0.000_ ;[Red]-0.000 "
-            
-            rs.Offset(0, 7).FormulaLocal = "=(" _
-                + rs.Offset(0, 6).Address _
-                + "-" _
-                + st.Offset(2, 1).Address _
-                + ") / " _
-                + st.Offset(2, 1).Address
-            rs.Offset(0, 7).NumberFormat = "0.000%; [Red]-0.000%"
-            rs.Offset(0, 8).FormulaLocal = "=ABS(" _
-                + rs.Offset(0, 7).Address _
-                + ")"
-            rs.Offset(0, 8).NumberFormat = "0.000%; [Red]-0.000%"
-            
-            If i < cutoffs Then
-                rs.Offset(0, 9).FormulaLocal = "=arctg(" _
-                    + rs.Offset(0, 2).Address _
-                    + "-Xo;" _
-                    + rs.Offset(0, 3).Address _
-                    + "-Yo)*180/Pi() - " _
-                    + rs.Offset(0, 0).Address
-            Else
-                rs.Offset(0, 9) = 0
-            End If
-            rs.Offset(0, 9).NumberFormat = "0.000; [Red]-0.000"
-            rs.Offset(0, 10).FormulaLocal = "=ABS(" _
-                + rs.Offset(0, 9).Address _
-                + ")/" _
-                + "360" 'astep.Address
-            rs.Offset(0, 10).NumberFormat = "0.000%; [Red]-0.000%"
-            Set rs = rs.Offset(1, 0)
-            sg = sg + step_g
-            sb = sb + step_b
-        Next i
-        
-        Set rs = wks.Range(wks.Range("Table")).Offset(0, 5)
-        For i = 1 To 6
-        
-            rs.Select
-            
-            wks.Range(Selection, Selection.End(xlDown)).Select
-            
-            st.Offset(0, 0).FormulaLocal = "=min(" + Selection.Address + ")"
-            st.Offset(0, 0).NumberFormat = Selection.NumberFormat
-            st.Offset(1, 0).FormulaLocal = "=max(" + Selection.Address + ")"
-            st.Offset(1, 0).NumberFormat = Selection.NumberFormat
-            st.Offset(2, 0).FormulaLocal = "=average(" + Selection.Address + ")"
-            st.Offset(2, 0).NumberFormat = Selection.NumberFormat
-            st.Offset(3, 0).FormulaLocal = "=" + st.Offset(1, 0).Address + "-" + st.Offset(0, 0).Address
-            st.Offset(3, 0).NumberFormat = Selection.NumberFormat
-            Set rs = rs.Offset(0, 1)
-            Set st = st.Offset(0, 1)
-        Next i
-        wks.Range("A1").Select
-        wks.EnableCalculation = True
-        wks.Calculate
-    End With
-End Sub
-
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_COL_S As String = "B"
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-' Fields indexes in IN_TABLES
-Public Const IN_ACCOUNT_IDX As Integer = 0
-Public Const IN_TYPE_IDX As Integer = 1
-Public Const IN_STORAGE_IDX As Integer = 2
-Public Const IN_LAST_IDX As Integer = 3
-Public Const IN_IP_IDX As Integer = 4
-
-' Report lists names
-Public Const STA_USER_FEM As String = "Female_Users"
-Public Const STA_USER_MAL As String = "Male_Users"
-Public Const STA_USER_SML As String = "SendMail_Users"
-Public Const STA_USER_TOT As String = "Total_Users"
-Public Const BAD_USER_FEM As String = "Female_Bad_Users"
-Public Const BAD_USER_MAL As String = "Male_Bad_Users"
-Public Const BAD_USER_SML As String = "SendMail_Bad_Users"
-Public Const MAINTAIN_USER_LST As String = "STICKLY"
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mStatUser
->>>>>>
-Attribute VB_Name = "mStatUser"
-Option Explicit
-' Fields indexes in STAT_TABLES
-Public Const BAD_HEADER_RANGE As String = "A2"
-Public Const BAD_DATA_RANGE As String = "A3"
-Public Const BAD_DATA_RANGE_COL As Integer = 1
-Public Const BAD_DATA_RANGE_ROW As Integer = 3
-
-Public Const STA_DATA_RANGE As String = "A3"
-Public Const STA_DATA_RANGE_COL As Integer = 1
-Public Const STA_DATA_RANGE_ROW As Integer = 3
-
-Public Const STA_DATE_IDX As Integer = 0
-Public Const STA_TIME_IDX As Integer = 1
-
-Public Const STA_USERS_IDX As Integer = STA_TIME_IDX + 1
-Public Const STA_NEW_USERS_IDX As Integer = STA_TIME_IDX + 2
-Public Const STA_BAD_USERS_IDX As Integer = STA_TIME_IDX + 3
-
-Public Const STA_DISK_COMMON_IDX As Integer = STA_BAD_USERS_IDX + 1
-Public Const STA_DISK_MAX_IDX As Integer = STA_BAD_USERS_IDX + 2
-Public Const STA_DISK_AVR_IDX As Integer = STA_BAD_USERS_IDX + 3
-Public Const STA_DISK_BAD_MAX_IDX As Integer = STA_BAD_USERS_IDX + 4
-Public Const STA_DISK_BAD_AVR_IDX As Integer = STA_BAD_USERS_IDX + 5
-
-Public Const STA_DISK_HIS_0_IDX As Integer = STA_DISK_BAD_AVR_IDX + 1
-Public Const STA_DISK_HIS_30_IDX As Integer = STA_DISK_BAD_AVR_IDX + 2
-Public Const STA_DISK_HIS_100_IDX As Integer = STA_DISK_BAD_AVR_IDX + 3
-Public Const STA_DISK_HIS_300_IDX As Integer = STA_DISK_BAD_AVR_IDX + 4
-Public Const STA_DISK_HIS_1000_IDX As Integer = STA_DISK_BAD_AVR_IDX + 5
-Public Const STA_DISK_HIS_3000_IDX As Integer = STA_DISK_BAD_AVR_IDX + 6
-Public Const STA_DISK_HIS_BIG_IDX As Integer = STA_DISK_BAD_AVR_IDX + 7
-
-Public Const STA_TIME_HIS_0D_IDX As Integer = STA_DISK_HIS_BIG_IDX + 1
-Public Const STA_TIME_HIS_3D_IDX As Integer = STA_DISK_HIS_BIG_IDX + 2
-Public Const STA_TIME_HIS_1W_IDX As Integer = STA_DISK_HIS_BIG_IDX + 3
-Public Const STA_TIME_HIS_2W_IDX As Integer = STA_DISK_HIS_BIG_IDX + 4
-Public Const STA_TIME_HIS_1M_IDX As Integer = STA_DISK_HIS_BIG_IDX + 5
-Public Const STA_TIME_HIS_2M_IDX As Integer = STA_DISK_HIS_BIG_IDX + 6
-
-Private Const DISK_RANG_0 As Integer = 0
-Private Const DISK_RANG_30 As Integer = 30
-Private Const DISK_RANG_100 As Integer = 100
-Private Const DISK_RANG_300 As Integer = 300
-Private Const DISK_RANG_1000 As Integer = 1000
-Private Const DISK_RANG_3000 As Integer = 3000
-
-Private Const TIME_RANG_0D As Integer = 0
-Private Const TIME_RANG_3D As Integer = 2
-Private Const TIME_RANG_1W As Integer = 7
-Private Const TIME_RANG_2W As Integer = 14
-Private Const TIME_RANG_1M As Integer = 30
-Private Const TIME_RANG_2M As Integer = 60
-
-Private Const FEMALE_GOOD_RANGE_COL As Integer = "2"
-Private Const MALE_GOOD_RANGE_COL As Integer = "3"
-Private Const SENDMAIL_GOOD_RANGE_COL As Integer = "4"
-Private Const GOOD_RANGE_ROW As Integer = "3"
-
-' Common data types
-Type TUserStatData
-    theDate As Date
-    theTime As Date
-    lUsersCount As Long
-    lUsersNew As Long
-    lUsersBad As Long
-    lDiskTotal As Long
-    lDiskMax As Long
-    lDiskAvr As Long
-    lDiskBad As Long
-    lDiskBadAvr As Long
-    lDisk_0 As Long
-    lDisk_30 As Long
-    lDisk_100 As Long
-    lDisk_300 As Long
-    lDisk_1000 As Long
-    lDisk_3000 As Long
-    lDisk_Big As Long
-    lTime_0D As Long
-    lTime_3D As Long
-    lTime_1W As Long
-    lTime_2W As Long
-    lTime_1M As Long
-    lTime_2M As Long
-End Type
-
-Type TBadUser
-    theName As String
-    lLast As Date
-    lDiskSize As Long
-End Type
-
-' Comon data declaration
-Public UserStat As TUserStatData
-Public BadUserList() As TBadUser
-
-Sub GetUserStat(ws As Worksheet, us As TUserStatData, bu() As TBadUser, DOMEN_Idx As String)
-    Dim Location, GoodList As Range
-    Dim GoodRangeCollounm As Integer
-    
-    
-    With us
-        .theDate = Now
-        .theTime = Now
-        .lUsersCount = 0
-        .lUsersNew = 0
-        .lUsersBad = 0
-        .lDiskTotal = 0
-        .lDiskMax = 0
-        .lDiskAvr = 0
-        .lDiskBad = 0
-        .lDiskBadAvr = 0
-        .lDisk_0 = 0
-        .lDisk_30 = 0
-        .lDisk_100 = 0
-        .lDisk_300 = 0
-        .lDisk_1000 = 0
-        .lDisk_3000 = 0
-        .lDisk_Big = 0
-        .lTime_0D = 0
-        .lTime_3D = 0
-        .lTime_1W = 0
-        .lTime_2W = 0
-        .lTime_1M = 0
-        .lTime_2M = 0
-    End With
-    
-    With ws
-        us.lUsersCount = GetLinesCount(.Range(RAW_DATA_RANGE).Offset(1, 0))
-        Set Location = .Range( _
-            .Cells(RAW_DATA_RANGE_ROW + 1, RAW_DATA_RANGE_COL + IN_STORAGE_IDX), _
-            .Cells(RAW_DATA_RANGE_ROW + us.lUsersCount, RAW_DATA_RANGE_COL + IN_STORAGE_IDX) _
-        )
-        Dim c, d As Variant
-        
-        For Each c In Location
-            us.lDiskTotal = us.lDiskTotal + c.Value
-            If us.lDiskMax < c.Value Then
-                us.lDiskMax = c.Value
-            End If
-            If c.Value = DISK_RANG_0 Then
-                us.lDisk_0 = us.lDisk_0 + 1
-            Else
-                If c.Value < DISK_RANG_30 Then
-                    us.lDisk_30 = us.lDisk_30 + 1
-                Else
-                    If c.Value < DISK_RANG_100 Then
-                        us.lDisk_100 = us.lDisk_100 + 1
-                    Else
-                        If c.Value < DISK_RANG_300 Then
-                            us.lDisk_300 = us.lDisk_300 + 1
-                        Else
-                            If c.Value < DISK_RANG_1000 Then
-                                us.lDisk_1000 = us.lDisk_1000 + 1
-                            Else
-                                If c.Value < DISK_RANG_3000 Then
-                                    us.lDisk_3000 = us.lDisk_3000 + 1
-                                Else
-                                    us.lDisk_Big = us.lDisk_Big + 1
-                                End If
-                            End If
-                        End If
-                    End If
-                End If
-            End If
-        Next c
-        us.lDiskAvr = us.lDiskTotal / us.lUsersCount
-        
-        Set Location = .Range( _
-            .Cells(RAW_DATA_RANGE_ROW + 1, RAW_DATA_RANGE_COL + IN_LAST_IDX), _
-            .Cells(RAW_DATA_RANGE_ROW + us.lUsersCount, RAW_DATA_RANGE_COL + IN_LAST_IDX) _
-        )
-        
-        Dim HowLong As Integer
-        ReDim bu(us.lUsersCount) As TBadUser
-        Dim i_bad As Long
-        i_bad = LBound(bu)
-                
-        If DOMEN_Idx = STA_USER_SML Then
-            GoodRangeCollounm = SENDMAIL_GOOD_RANGE_COL
-        Else
-            If DOMEN_Idx = STA_USER_MAL Then
-                GoodRangeCollounm = MALE_GOOD_RANGE_COL
-            Else
-                GoodRangeCollounm = FEMALE_GOOD_RANGE_COL
-            End If
-        End If
-        
-        With Worksheets(MAINTAIN_USER_LST)
-            Set GoodList = .Range( _
-                .Cells(GOOD_RANGE_ROW, GoodRangeCollounm), _
-                .Cells(GOOD_RANGE_ROW, GoodRangeCollounm) _
-            )
-        End With
-        
-        For Each c In Location
-            If IsDate(c.Value) Then
-                HowLong = -DateDiff("d", Now, c.Value)
-                If HowLong = TIME_RANG_0D Then
-                    us.lTime_0D = us.lTime_0D + 1
-                Else
-                    If HowLong <= TIME_RANG_3D Then
-                        us.lTime_3D = us.lTime_3D + 1
-                    Else
-                        If HowLong <= TIME_RANG_1W Then
-                            us.lTime_1W = us.lTime_1W + 1
-                        Else
-                            If HowLong <= TIME_RANG_2W Then
-                                us.lTime_2W = us.lTime_2W + 1
-                            Else
-                                If HowLong <= TIME_RANG_1M Then
-                                    us.lTime_1M = us.lTime_1M + 1
-                                Else
-                                    If HowLong <= TIME_RANG_2M Then
-                                        us.lTime_2M = us.lTime_2M + 1
-                                    Else
-                                        If Not NameInGoodUserList(GoodList, c.Offset(0, -3).Value) Then
-                                            us.lUsersBad = us.lUsersBad + 1
-                                            bu(i_bad).theName = c.Offset(0, -3).Value
-                                            bu(i_bad).lLast = c.Value
-                                            bu(i_bad).lDiskSize = c.Offset(0, -1).Value
-                                            us.lDiskBad = us.lDiskBad + c.Offset(0, -1).Value
-                                            i_bad = i_bad + 1
-                                        End If
-                                    End If
-                                End If
-                            End If
-                        End If
-                    End If
-                End If
-            Else
-                us.lTime_0D = us.lTime_0D + 1
-            End If
-        Next c
-        ReDim bad_users(i_bad)
-        
-        us.lDiskBadAvr = us.lDiskBad / i_bad
-        
-    End With ' with ws
-End Sub
-
-Sub WriteResultUsers(ws As Worksheet, us As TUserStatData)
-    Dim curline As Integer
-    Dim Location As Range
-    With ws
-        Set Location = .Range( _
-                .Cells(STA_DATA_RANGE_ROW, STA_DATA_RANGE_COL), _
-                .Cells(STA_DATA_RANGE_ROW, STA_DATA_RANGE_COL) _
-            )
-        curline = GetLinesCount(Location)
-        With .Range( _
-                .Cells(STA_DATA_RANGE_ROW + curline, STA_DATA_RANGE_COL), _
-                .Cells(STA_DATA_RANGE_ROW + curline, STA_DATA_RANGE_COL) _
-            )
-            .Offset(0, STA_DATE_IDX).Value = us.theDate
-            .Offset(0, STA_DATE_IDX).NumberFormat = "dd-mmm-yy"
-            
-            .Offset(0, STA_TIME_IDX).Value = us.theTime
-            .Offset(0, STA_TIME_IDX).NumberFormat = "hh:mm"
-            
-            .Offset(0, STA_USERS_IDX).Value = us.lUsersCount
-            If curline > 0 Then
-                us.lUsersNew = us.lUsersCount - .Offset(-1, STA_USERS_IDX).Value
-            End If
-            .Offset(0, STA_NEW_USERS_IDX).Value = us.lUsersNew
-            .Offset(0, STA_BAD_USERS_IDX).Value = us.lUsersBad
-            .Offset(0, STA_DISK_COMMON_IDX).Value = us.lDiskTotal
-            .Offset(0, STA_DISK_MAX_IDX).Value = us.lDiskMax
-            .Offset(0, STA_DISK_AVR_IDX).Value = us.lDiskAvr
-            .Offset(0, STA_DISK_BAD_MAX_IDX).Value = us.lDiskBad
-            .Offset(0, STA_DISK_BAD_AVR_IDX).Value = us.lDiskBadAvr
-            .Offset(0, STA_DISK_HIS_0_IDX).Value = us.lDisk_0
-            .Offset(0, STA_DISK_HIS_30_IDX).Value = us.lDisk_30
-            .Offset(0, STA_DISK_HIS_100_IDX).Value = us.lDisk_100
-            .Offset(0, STA_DISK_HIS_300_IDX).Value = us.lDisk_300
-            .Offset(0, STA_DISK_HIS_1000_IDX).Value = us.lDisk_1000
-            .Offset(0, STA_DISK_HIS_3000_IDX).Value = us.lDisk_3000
-            .Offset(0, STA_DISK_HIS_BIG_IDX).Value = us.lDisk_Big
-            .Offset(0, STA_TIME_HIS_0D_IDX).Value = us.lTime_0D
-            .Offset(0, STA_TIME_HIS_3D_IDX).Value = us.lTime_3D
-            .Offset(0, STA_TIME_HIS_1W_IDX).Value = us.lTime_1W
-            .Offset(0, STA_TIME_HIS_2W_IDX).Value = us.lTime_2W
-            .Offset(0, STA_TIME_HIS_1M_IDX).Value = us.lTime_1M
-            .Offset(0, STA_TIME_HIS_2M_IDX).Value = us.lTime_2M
-        End With 'With .Range( _
-
-    End With 'With ws
-End Sub
-
-Sub WriteCommonResult(ws As Worksheet)
-    Dim LastLine As Integer
-    Dim Location As Range
-    Set Location = ws.Range(STA_DATA_RANGE)
-    LastLine = GetLinesCount(Location)
-    Set Location = Location.Offset(LastLine, 0)
-    While Not IsEmpty(Location.Offset(-1, 0))
-        Location.Fo = Location.Offset(-1, 0)
-        ' ws.Paste
-        Set Location = Location.Offset(0, 1)
-    Wend
-End Sub
-
-Sub WriteBadUsers(ws As Worksheet, bad_users() As TBadUser)
-    Dim Location As Range
-    
-    With ws
-        .Parent.Application.DisplayAlerts = False
-        .Range( _
-            .Cells(BAD_DATA_RANGE_ROW, BAD_DATA_RANGE_COL), _
-            .Cells(65535, BAD_DATA_RANGE_COL + 3) _
-        ).ClearContents
-
-        Set Location = .Range( _
-                .Cells(BAD_DATA_RANGE_ROW, BAD_DATA_RANGE_COL), _
-                .Cells(BAD_DATA_RANGE_ROW, BAD_DATA_RANGE_COL) _
-            )
-        
-        Dim i As Integer
-        
-        For i = LBound(bad_users()) To UBound(bad_users())
-            If bad_users(i).theName = "" Then
-                Exit For
-            End If
-            Location.Offset(i, 0).Value = bad_users(i).theName
-            Location.Offset(i, 1).Value = bad_users(i).lLast
-            Location.Offset(i, 1).NumberFormat = "dd-mmm-yy"
-            Location.Offset(i, 2).Value = bad_users(i).lDiskSize
-        Next i
-        
-        Set Location = .Range( _
-                .Cells(BAD_DATA_RANGE_ROW - 1, BAD_DATA_RANGE_COL), _
-                .Cells(BAD_DATA_RANGE_ROW + i, BAD_DATA_RANGE_COL + 2) _
-            )
-        
-        Location.Sort _
-            Key1:=.Range(BAD_HEADER_RANGE).Offset(0, 1), _
-            Order1:=xlAscending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-        
-        ReDim bad_users(0)
-    End With
-End Sub
-
-Function NameInGoodUserList(GoodList As Range, uname As String) As Boolean
-    Dim i, maxLines As Integer
-    maxLines = GetLinesCount(GoodList) + 1
-    
-    NameInGoodUserList = False
-    
-    For i = 0 To maxLines
-        If GoodList.Offset(i, 0).Value = uname Then
-            NameInGoodUserList = True
-            Exit For
-        End If
-    Next i
-    
-End Function
-<<<<<<
-======================
-mFileOpen
->>>>>>
-Attribute VB_Name = "mFileOpen"
-Option Explicit
-
-Public Const MAX_LOAD_DATA_LINES As Integer = 16000
-
-Public Const MSG_FILE_INVALID_FORMAT As String = "�������� ������ �����"
-
-Public Const FUNCRES_FILE_OK As Integer = 0
-Public Const FUNCRES_FILE_VERY_SMALL As Integer = -1
-Public Const FUNCRES_FILE_INVALID_FORMAT As Integer = -2
-
-Public Const HOME_PAGE_NAME As String = "HomePage"
-Public Const DOMAIN_NAME_IDX As String = "D5"
-
-Public Const FEMALE_NAME_IDX As String = "1"
-Public Const MALE_NAME_IDX As String = "2"
-Public Const SMAIL_NAME_IDX As String = "3"
-
-Public Const FEMALE_FILE_NAME_ADR As String = "E3"
-Public Const MALE_FILE_NAME_ADR As String = "E5"
-Public Const SMAIL_FILE_NAME_ADR As String = "E7"
-
-
-
-Function UpdateHistoryFromFile(wb As Workbook, FileToOpen As String) As Integer
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim Location As Range
-
-    Dim SingleFileLine As String
-    Dim FileHandler As Integer
-    Dim i, row_idx As Integer
-    
-    UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-    With wb
-'        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            'Clear table include temp area
-            .Parent.Application.DisplayAlerts = False
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + IN_IP_IDX + 3) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            
-            ' Reading data from file
-            FileHandler = FreeFile
-            row_idx = 0
-            Open FileToOpen For Input As #FileHandler
-            Do While Not EOF(FileHandler) And row_idx < MAX_LOAD_DATA_LINES
-                Line Input #FileHandler, SingleFileLine
-                .Range(RAW_DATA_RANGE).Offset(row_idx, 0) = SingleFileLine
-                row_idx = row_idx + 1
-            Loop
-            Close #FileHandler
-            
-            ' Parsing data
-            DestRangeName = "=" & RAW_DATA_SHEET & "!" & RAW_DATA_RANGE & _
-                            ":" & RAW_DATA_RANGE_COL_S & (RAW_DATA_RANGE_ROW + row_idx)
-            ResultLength = row_idx
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=True, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-            .Parent.Application.DisplayAlerts = True
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            
-            row_idx = row_idx - 1
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + 1, RAW_DATA_RANGE_COL + IN_STORAGE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + IN_STORAGE_IDX) _
-            )
-            Dim c As Variant
-            For Each c In Location
-                c.Value = ChkAccountSize(c.Value)
-            Next c
-        End With ' With .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromFile = FUNCRES_FILE_OK
-End Function
-
-Function ChkAccountSize(strSize As String) As Long
-    Dim ChNum As Long
-    ChNum = InStr(strSize, "K")
-    If ChNum = 0 Then
-        ChNum = InStr(strSize, "M")
-        If ChNum = 0 Then
-            ChkAccountSize = Val(strSize) / 1024
-        Else
-            strSize = Left(strSize, ChNum - 1)
-            ChNum = Val(strSize)
-            ChkAccountSize = ChNum * 1024
-        End If
-    Else
-        strSize = Left(strSize, ChNum - 1)
-        ChNum = Val(strSize)
-        ChkAccountSize = ChNum
-    End If
-End Function
-
-Sub SetFile()
-    Dim FileToOpen As Variant
-    Dim DomainIdx As Range
-    Dim WSh As Worksheet
-    
-    FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
-    If FileToOpen = False Then
-        MsgBox "No file select"
-    Else
-        MsgBox "Selected file is :" & FileToOpen
-    End If
-    Set WSh = ThisWorkbook.Sheets(HOME_PAGE_NAME)
-    With WSh
-        If .Range(DOMAIN_NAME_IDX) = FEMALE_NAME_IDX Then
-            Set DomainIdx = .Range(FEMALE_FILE_NAME_ADR)
-        Else
-            If .Range(DOMAIN_NAME_IDX) = MALE_NAME_IDX Then
-                Set DomainIdx = .Range(MALE_FILE_NAME_ADR)
-            Else
-                Set DomainIdx = .Range(SMAIL_FILE_NAME_ADR)
-            End If
-        End If
-        DomainIdx = FileToOpen
-        With DomainIdx.Font
-            .Name = "Arial"
-            .FontStyle = "Bold"
-            .Size = 10
-            .Strikethrough = False
-            .Superscript = False
-            .Subscript = False
-            .OutlineFont = False
-            .Shadow = False
-            .Underline = xlUnderlineStyleNone
-            .ColorIndex = xlAutomatic
-        End With 'DomainIdx
-    End With ' WSh
-End Sub
-
-<<<<<<
-======================
-mPrg
->>>>>>
-Attribute VB_Name = "mPrg"
-Option Explicit
-
-Sub ReCalc()
-    Dim wb As Workbook
-    Dim FileToOpen As String
-    Set wb = ThisWorkbook
-    
-    wb.Sheets(HOME_PAGE_NAME).EnableCalculation = False
-    
-    FileToOpen = wb.Sheets(HOME_PAGE_NAME).Range(FEMALE_FILE_NAME_ADR)
-    
-    UpdateHistoryFromFile wb, FileToOpen
-    GetUserStat wb.Sheets(RAW_DATA_SHEET), UserStat, BadUserList, STA_USER_FEM
-    WriteResultUsers wb.Sheets(STA_USER_FEM), UserStat
-    WriteBadUsers wb.Sheets(BAD_USER_FEM), BadUserList
-
-    FileToOpen = wb.Sheets(HOME_PAGE_NAME).Range(MALE_FILE_NAME_ADR)
-    UpdateHistoryFromFile wb, FileToOpen
-    GetUserStat wb.Sheets(RAW_DATA_SHEET), UserStat, BadUserList, STA_USER_MAL
-    WriteResultUsers wb.Sheets(STA_USER_MAL), UserStat
-    WriteBadUsers wb.Sheets(BAD_USER_MAL), BadUserList
-
-    FileToOpen = wb.Sheets(HOME_PAGE_NAME).Range(SMAIL_FILE_NAME_ADR)
-    UpdateHistoryFromFile wb, FileToOpen
-    GetUserStat wb.Sheets(RAW_DATA_SHEET), UserStat, BadUserList, STA_USER_SML
-    WriteResultUsers wb.Sheets(STA_USER_SML), UserStat
-    WriteBadUsers wb.Sheets(BAD_USER_SML), BadUserList
-    
-'    WriteCommonResult wb.Sheets(STA_USER_TOT)
-    
-    wb.Sheets(HOME_PAGE_NAME).EnableCalculation = True
-    Application.Calculate
-    
-    
-End Sub
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_COL_S As String = "B"
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-' Fields indexes in IN_TABLES
-Public Const IN_ACCOUNT_IDX As Integer = 0
-Public Const IN_TYPE_IDX As Integer = 1
-Public Const IN_STORAGE_IDX As Integer = 2
-Public Const IN_LAST_IDX As Integer = 3
-Public Const IN_IP_IDX As Integer = 4
-
-' Report lists names
-Public Const STA_USER_FEM As String = "Female_Users"
-Public Const STA_USER_MAL As String = "Male_Users"
-Public Const STA_USER_SML As String = "SendMail_Users"
-Public Const STA_USER_TOT As String = "Total_Users"
-Public Const BAD_USER_FEM As String = "Female_Bad_Users"
-Public Const BAD_USER_MAL As String = "Male_Bad_Users"
-Public Const BAD_USER_SML As String = "SendMail_Bad_Users"
-Public Const MAINTAIN_USER_LST As String = "STICKLY"
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mStatUser
->>>>>>
-Attribute VB_Name = "mStatUser"
-Option Explicit
-' Fields indexes in STAT_TABLES
-Public Const BAD_HEADER_RANGE As String = "A2"
-Public Const BAD_DATA_RANGE As String = "A3"
-Public Const BAD_DATA_RANGE_COL As Integer = 1
-Public Const BAD_DATA_RANGE_ROW As Integer = 3
-
-Public Const STA_DATA_RANGE As String = "A3"
-Public Const STA_DATA_RANGE_COL As Integer = 1
-Public Const STA_DATA_RANGE_ROW As Integer = 3
-
-Public Const STA_DATE_IDX As Integer = 0
-Public Const STA_TIME_IDX As Integer = 1
-
-Public Const STA_USERS_IDX As Integer = STA_TIME_IDX + 1
-Public Const STA_NEW_USERS_IDX As Integer = STA_TIME_IDX + 2
-Public Const STA_BAD_USERS_IDX As Integer = STA_TIME_IDX + 3
-
-Public Const STA_DISK_COMMON_IDX As Integer = STA_BAD_USERS_IDX + 1
-Public Const STA_DISK_MAX_IDX As Integer = STA_BAD_USERS_IDX + 2
-Public Const STA_DISK_AVR_IDX As Integer = STA_BAD_USERS_IDX + 3
-Public Const STA_DISK_BAD_MAX_IDX As Integer = STA_BAD_USERS_IDX + 4
-Public Const STA_DISK_BAD_AVR_IDX As Integer = STA_BAD_USERS_IDX + 5
-
-Public Const STA_DISK_HIS_0_IDX As Integer = STA_DISK_BAD_AVR_IDX + 1
-Public Const STA_DISK_HIS_30_IDX As Integer = STA_DISK_BAD_AVR_IDX + 2
-Public Const STA_DISK_HIS_100_IDX As Integer = STA_DISK_BAD_AVR_IDX + 3
-Public Const STA_DISK_HIS_300_IDX As Integer = STA_DISK_BAD_AVR_IDX + 4
-Public Const STA_DISK_HIS_1000_IDX As Integer = STA_DISK_BAD_AVR_IDX + 5
-Public Const STA_DISK_HIS_3000_IDX As Integer = STA_DISK_BAD_AVR_IDX + 6
-Public Const STA_DISK_HIS_BIG_IDX As Integer = STA_DISK_BAD_AVR_IDX + 7
-
-Public Const STA_TIME_HIS_0D_IDX As Integer = STA_DISK_HIS_BIG_IDX + 1
-Public Const STA_TIME_HIS_3D_IDX As Integer = STA_DISK_HIS_BIG_IDX + 2
-Public Const STA_TIME_HIS_1W_IDX As Integer = STA_DISK_HIS_BIG_IDX + 3
-Public Const STA_TIME_HIS_2W_IDX As Integer = STA_DISK_HIS_BIG_IDX + 4
-Public Const STA_TIME_HIS_1M_IDX As Integer = STA_DISK_HIS_BIG_IDX + 5
-Public Const STA_TIME_HIS_2M_IDX As Integer = STA_DISK_HIS_BIG_IDX + 6
-
-Private Const DISK_RANG_0 As Integer = 0
-Private Const DISK_RANG_30 As Integer = 30
-Private Const DISK_RANG_100 As Integer = 100
-Private Const DISK_RANG_300 As Integer = 300
-Private Const DISK_RANG_1000 As Integer = 1000
-Private Const DISK_RANG_3000 As Integer = 3000
-
-Private Const TIME_RANG_0D As Integer = 0
-Private Const TIME_RANG_3D As Integer = 2
-Private Const TIME_RANG_1W As Integer = 7
-Private Const TIME_RANG_2W As Integer = 14
-Private Const TIME_RANG_1M As Integer = 30
-Private Const TIME_RANG_2M As Integer = 60
-
-Private Const FEMALE_GOOD_RANGE_COL As Integer = "2"
-Private Const MALE_GOOD_RANGE_COL As Integer = "3"
-Private Const SENDMAIL_GOOD_RANGE_COL As Integer = "4"
-Private Const GOOD_RANGE_ROW As Integer = "3"
-
-' Common data types
-Type TUserStatData
-    theDate As Date
-    theTime As Date
-    lUsersCount As Long
-    lUsersNew As Long
-    lUsersBad As Long
-    lDiskTotal As Long
-    lDiskMax As Long
-    lDiskAvr As Long
-    lDiskBad As Long
-    lDiskBadAvr As Long
-    lDisk_0 As Long
-    lDisk_30 As Long
-    lDisk_100 As Long
-    lDisk_300 As Long
-    lDisk_1000 As Long
-    lDisk_3000 As Long
-    lDisk_Big As Long
-    lTime_0D As Long
-    lTime_3D As Long
-    lTime_1W As Long
-    lTime_2W As Long
-    lTime_1M As Long
-    lTime_2M As Long
-End Type
-
-Type TBadUser
-    theName As String
-    lLast As Date
-    lDiskSize As Long
-End Type
-
-' Comon data declaration
-Public UserStat As TUserStatData
-Public BadUserList() As TBadUser
-
-Sub GetUserStat(ws As Worksheet, us As TUserStatData, bu() As TBadUser, DOMEN_Idx As String)
-    Dim Location, GoodList As Range
-    Dim GoodRangeCollounm As Integer
-    
-    
-    With us
-        .theDate = Now
-        .theTime = Now
-        .lUsersCount = 0
-        .lUsersNew = 0
-        .lUsersBad = 0
-        .lDiskTotal = 0
-        .lDiskMax = 0
-        .lDiskAvr = 0
-        .lDiskBad = 0
-        .lDiskBadAvr = 0
-        .lDisk_0 = 0
-        .lDisk_30 = 0
-        .lDisk_100 = 0
-        .lDisk_300 = 0
-        .lDisk_1000 = 0
-        .lDisk_3000 = 0
-        .lDisk_Big = 0
-        .lTime_0D = 0
-        .lTime_3D = 0
-        .lTime_1W = 0
-        .lTime_2W = 0
-        .lTime_1M = 0
-        .lTime_2M = 0
-    End With
-    
-    With ws
-        us.lUsersCount = GetLinesCount(.Range(RAW_DATA_RANGE).Offset(1, 0))
-        Set Location = .Range( _
-            .Cells(RAW_DATA_RANGE_ROW + 1, RAW_DATA_RANGE_COL + IN_STORAGE_IDX), _
-            .Cells(RAW_DATA_RANGE_ROW + us.lUsersCount, RAW_DATA_RANGE_COL + IN_STORAGE_IDX) _
-        )
-        Dim c, d As Variant
-        
-        For Each c In Location
-            us.lDiskTotal = us.lDiskTotal + c.Value
-            If us.lDiskMax < c.Value Then
-                us.lDiskMax = c.Value
-            End If
-            If c.Value = DISK_RANG_0 Then
-                us.lDisk_0 = us.lDisk_0 + 1
-            Else
-                If c.Value < DISK_RANG_30 Then
-                    us.lDisk_30 = us.lDisk_30 + 1
-                Else
-                    If c.Value < DISK_RANG_100 Then
-                        us.lDisk_100 = us.lDisk_100 + 1
-                    Else
-                        If c.Value < DISK_RANG_300 Then
-                            us.lDisk_300 = us.lDisk_300 + 1
-                        Else
-                            If c.Value < DISK_RANG_1000 Then
-                                us.lDisk_1000 = us.lDisk_1000 + 1
-                            Else
-                                If c.Value < DISK_RANG_3000 Then
-                                    us.lDisk_3000 = us.lDisk_3000 + 1
-                                Else
-                                    us.lDisk_Big = us.lDisk_Big + 1
-                                End If
-                            End If
-                        End If
-                    End If
-                End If
-            End If
-        Next c
-        us.lDiskAvr = us.lDiskTotal / us.lUsersCount
-        
-        Set Location = .Range( _
-            .Cells(RAW_DATA_RANGE_ROW + 1, RAW_DATA_RANGE_COL + IN_LAST_IDX), _
-            .Cells(RAW_DATA_RANGE_ROW + us.lUsersCount, RAW_DATA_RANGE_COL + IN_LAST_IDX) _
-        )
-        
-        Dim HowLong As Integer
-        ReDim bu(us.lUsersCount) As TBadUser
-        Dim i_bad As Long
-        i_bad = LBound(bu)
-                
-        If DOMEN_Idx = STA_USER_SML Then
-            GoodRangeCollounm = SENDMAIL_GOOD_RANGE_COL
-        Else
-            If DOMEN_Idx = STA_USER_MAL Then
-                GoodRangeCollounm = MALE_GOOD_RANGE_COL
-            Else
-                GoodRangeCollounm = FEMALE_GOOD_RANGE_COL
-            End If
-        End If
-        
-        With Worksheets(MAINTAIN_USER_LST)
-            Set GoodList = .Range( _
-                .Cells(GOOD_RANGE_ROW, GoodRangeCollounm), _
-                .Cells(GOOD_RANGE_ROW, GoodRangeCollounm) _
-            )
-        End With
-        
-        For Each c In Location
-            If IsDate(c.Value) Then
-                HowLong = -DateDiff("d", Now, c.Value)
-                If HowLong = TIME_RANG_0D Then
-                    us.lTime_0D = us.lTime_0D + 1
-                Else
-                    If HowLong <= TIME_RANG_3D Then
-                        us.lTime_3D = us.lTime_3D + 1
-                    Else
-                        If HowLong <= TIME_RANG_1W Then
-                            us.lTime_1W = us.lTime_1W + 1
-                        Else
-                            If HowLong <= TIME_RANG_2W Then
-                                us.lTime_2W = us.lTime_2W + 1
-                            Else
-                                If HowLong <= TIME_RANG_1M Then
-                                    us.lTime_1M = us.lTime_1M + 1
-                                Else
-                                    If HowLong <= TIME_RANG_2M Then
-                                        us.lTime_2M = us.lTime_2M + 1
-                                    Else
-                                        If Not NameInGoodUserList(GoodList, c.Offset(0, -3).Value) Then
-                                            us.lUsersBad = us.lUsersBad + 1
-                                            bu(i_bad).theName = c.Offset(0, -3).Value
-                                            bu(i_bad).lLast = c.Value
-                                            bu(i_bad).lDiskSize = c.Offset(0, -1).Value
-                                            us.lDiskBad = us.lDiskBad + c.Offset(0, -1).Value
-                                            i_bad = i_bad + 1
-                                        End If
-                                    End If
-                                End If
-                            End If
-                        End If
-                    End If
-                End If
-            Else
-                us.lTime_0D = us.lTime_0D + 1
-            End If
-        Next c
-        ReDim bad_users(i_bad)
-        
-        us.lDiskBadAvr = us.lDiskBad / i_bad
-        
-    End With ' with ws
-End Sub
-
-Sub WriteResultUsers(ws As Worksheet, us As TUserStatData)
-    Dim curline As Integer
-    Dim Location As Range
-    With ws
-        Set Location = .Range( _
-                .Cells(STA_DATA_RANGE_ROW, STA_DATA_RANGE_COL), _
-                .Cells(STA_DATA_RANGE_ROW, STA_DATA_RANGE_COL) _
-            )
-        curline = GetLinesCount(Location)
-        With .Range( _
-                .Cells(STA_DATA_RANGE_ROW + curline, STA_DATA_RANGE_COL), _
-                .Cells(STA_DATA_RANGE_ROW + curline, STA_DATA_RANGE_COL) _
-            )
-            .Offset(0, STA_DATE_IDX).Value = us.theDate
-            .Offset(0, STA_DATE_IDX).NumberFormat = "dd-mmm-yy"
-            
-            .Offset(0, STA_TIME_IDX).Value = us.theTime
-            .Offset(0, STA_TIME_IDX).NumberFormat = "hh:mm"
-            
-            .Offset(0, STA_USERS_IDX).Value = us.lUsersCount
-            If curline > 0 Then
-                us.lUsersNew = us.lUsersCount - .Offset(-1, STA_USERS_IDX).Value
-            End If
-            .Offset(0, STA_NEW_USERS_IDX).Value = us.lUsersNew
-            .Offset(0, STA_BAD_USERS_IDX).Value = us.lUsersBad
-            .Offset(0, STA_DISK_COMMON_IDX).Value = us.lDiskTotal
-            .Offset(0, STA_DISK_MAX_IDX).Value = us.lDiskMax
-            .Offset(0, STA_DISK_AVR_IDX).Value = us.lDiskAvr
-            .Offset(0, STA_DISK_BAD_MAX_IDX).Value = us.lDiskBad
-            .Offset(0, STA_DISK_BAD_AVR_IDX).Value = us.lDiskBadAvr
-            .Offset(0, STA_DISK_HIS_0_IDX).Value = us.lDisk_0
-            .Offset(0, STA_DISK_HIS_30_IDX).Value = us.lDisk_30
-            .Offset(0, STA_DISK_HIS_100_IDX).Value = us.lDisk_100
-            .Offset(0, STA_DISK_HIS_300_IDX).Value = us.lDisk_300
-            .Offset(0, STA_DISK_HIS_1000_IDX).Value = us.lDisk_1000
-            .Offset(0, STA_DISK_HIS_3000_IDX).Value = us.lDisk_3000
-            .Offset(0, STA_DISK_HIS_BIG_IDX).Value = us.lDisk_Big
-            .Offset(0, STA_TIME_HIS_0D_IDX).Value = us.lTime_0D
-            .Offset(0, STA_TIME_HIS_3D_IDX).Value = us.lTime_3D
-            .Offset(0, STA_TIME_HIS_1W_IDX).Value = us.lTime_1W
-            .Offset(0, STA_TIME_HIS_2W_IDX).Value = us.lTime_2W
-            .Offset(0, STA_TIME_HIS_1M_IDX).Value = us.lTime_1M
-            .Offset(0, STA_TIME_HIS_2M_IDX).Value = us.lTime_2M
-        End With 'With .Range( _
-
-    End With 'With ws
-End Sub
-
-Sub WriteCommonResult(ws As Worksheet)
-    Dim LastLine As Integer
-    Dim Location As Range
-    Set Location = ws.Range(STA_DATA_RANGE)
-    LastLine = GetLinesCount(Location)
-    Set Location = Location.Offset(LastLine, 0)
-    While Not IsEmpty(Location.Offset(-1, 0))
-        Location.Fo = Location.Offset(-1, 0)
-        ' ws.Paste
-        Set Location = Location.Offset(0, 1)
-    Wend
-End Sub
-
-Sub WriteBadUsers(ws As Worksheet, bad_users() As TBadUser)
-    Dim Location As Range
-    
-    With ws
-        .Parent.Application.DisplayAlerts = False
-        .Range( _
-            .Cells(BAD_DATA_RANGE_ROW, BAD_DATA_RANGE_COL), _
-            .Cells(65535, BAD_DATA_RANGE_COL + 3) _
-        ).ClearContents
-
-        Set Location = .Range( _
-                .Cells(BAD_DATA_RANGE_ROW, BAD_DATA_RANGE_COL), _
-                .Cells(BAD_DATA_RANGE_ROW, BAD_DATA_RANGE_COL) _
-            )
-        
-        Dim i As Integer
-        
-        For i = LBound(bad_users()) To UBound(bad_users())
-            If bad_users(i).theName = "" Then
-                Exit For
-            End If
-            Location.Offset(i, 0).Value = bad_users(i).theName
-            Location.Offset(i, 1).Value = bad_users(i).lLast
-            Location.Offset(i, 1).NumberFormat = "dd-mmm-yy"
-            Location.Offset(i, 2).Value = bad_users(i).lDiskSize
-        Next i
-        
-        Set Location = .Range( _
-                .Cells(BAD_DATA_RANGE_ROW - 1, BAD_DATA_RANGE_COL), _
-                .Cells(BAD_DATA_RANGE_ROW + i, BAD_DATA_RANGE_COL + 2) _
-            )
-        
-        Location.Sort _
-            Key1:=.Range(BAD_HEADER_RANGE).Offset(0, 1), _
-            Order1:=xlAscending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-        
-        ReDim bad_users(0)
-    End With
-End Sub
-
-Function NameInGoodUserList(GoodList As Range, uname As String) As Boolean
-    Dim i, maxLines As Integer
-    maxLines = GetLinesCount(GoodList) + 1
-    
-    NameInGoodUserList = False
-    
-    For i = 0 To maxLines
-        If GoodList.Offset(i, 0).Value = uname Then
-            NameInGoodUserList = True
-            Exit For
-        End If
-    Next i
-    
-End Function
-<<<<<<
-======================
-mFileOpen
->>>>>>
-Attribute VB_Name = "mFileOpen"
-Option Explicit
-
-Public Const MAX_LOAD_DATA_LINES As Integer = 16000
-
-Public Const MSG_FILE_INVALID_FORMAT As String = "�������� ������ �����"
-
-Public Const FUNCRES_FILE_OK As Integer = 0
-Public Const FUNCRES_FILE_VERY_SMALL As Integer = -1
-Public Const FUNCRES_FILE_INVALID_FORMAT As Integer = -2
-
-Public Const SETUP_PAGE_NAME As String = "Setup"
-Public Const HOME_PAGE_NAME As String = "HomePage"
-Public Const DOMAIN_NAME_IDX As String = "D5"
-
-Public Const FEMALE_NAME_IDX As String = "1"
-Public Const MALE_NAME_IDX As String = "2"
-Public Const SMAIL_NAME_IDX As String = "3"
-
-Public Const FEMALE_FILE_NAME_ADR As String = "E3"
-Public Const MALE_FILE_NAME_ADR As String = "E5"
-Public Const SMAIL_FILE_NAME_ADR As String = "E7"
-
-
-
-Function UpdateHistoryFromFile(wb As Workbook, FileToOpen As String) As Integer
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim Location As Range
-
-    Dim SingleFileLine As String
-    Dim FileHandler As Integer
-    Dim i, row_idx As Integer
-    
-    UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-    With wb
-'        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            'Clear table include temp area
-            .Parent.Application.DisplayAlerts = False
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + IN_IP_IDX + 3) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            
-            ' Reading data from file
-            FileHandler = FreeFile
-            row_idx = 0
-            Open FileToOpen For Input As #FileHandler
-            Do While Not EOF(FileHandler) And row_idx < MAX_LOAD_DATA_LINES
-                Line Input #FileHandler, SingleFileLine
-                .Range(RAW_DATA_RANGE).Offset(row_idx, 0) = SingleFileLine
-                row_idx = row_idx + 1
-            Loop
-            Close #FileHandler
-            
-            ' Parsing data
-            DestRangeName = "=" & RAW_DATA_SHEET & "!" & RAW_DATA_RANGE & _
-                            ":" & RAW_DATA_RANGE_COL_S & (RAW_DATA_RANGE_ROW + row_idx)
-            ResultLength = row_idx
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=True, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-            .Parent.Application.DisplayAlerts = True
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            
-            row_idx = row_idx - 1
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + 1, RAW_DATA_RANGE_COL + IN_STORAGE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + IN_STORAGE_IDX) _
-            )
-            Dim c As Variant
-            For Each c In Location
-                c.Value = ChkAccountSize(c.Value)
-            Next c
-        End With ' With .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromFile = FUNCRES_FILE_OK
-End Function
-
-Function ChkAccountSize(strSize As String) As Long
-    Dim ChNum As Long
-    ChNum = InStr(strSize, "K")
-    If ChNum = 0 Then
-        ChNum = InStr(strSize, "M")
-        If ChNum = 0 Then
-            ChkAccountSize = Val(strSize) / 1024
-        Else
-            strSize = Left(strSize, ChNum - 1)
-            ChNum = Val(strSize)
-            ChkAccountSize = ChNum * 1024
-        End If
-    Else
-        strSize = Left(strSize, ChNum - 1)
-        ChNum = Val(strSize)
-        ChkAccountSize = ChNum
-    End If
-End Function
-
-Sub SetFile()
-    Dim FileToOpen As Variant
-    Dim DomainIdx As Range
-    Dim WSh As Worksheet
-    
-    FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
-    If FileToOpen = False Then
-        MsgBox "No file select"
-    Else
-        MsgBox "Selected file is :" & FileToOpen
-    End If
-    Set WSh = ThisWorkbook.Sheets(HOME_PAGE_NAME)
-    With WSh
-        If .Range(DOMAIN_NAME_IDX) = FEMALE_NAME_IDX Then
-            Set DomainIdx = .Range(FEMALE_FILE_NAME_ADR)
-        Else
-            If .Range(DOMAIN_NAME_IDX) = MALE_NAME_IDX Then
-                Set DomainIdx = .Range(MALE_FILE_NAME_ADR)
-            Else
-                Set DomainIdx = .Range(SMAIL_FILE_NAME_ADR)
-            End If
-        End If
-        DomainIdx = FileToOpen
-        With DomainIdx.Font
-            .Name = "Arial"
-            .FontStyle = "Bold"
-            .Size = 10
-            .Strikethrough = False
-            .Superscript = False
-            .Subscript = False
-            .OutlineFont = False
-            .Shadow = False
-            .Underline = xlUnderlineStyleNone
-            .ColorIndex = xlAutomatic
-        End With 'DomainIdx
-    End With ' WSh
-End Sub
-
-<<<<<<
-======================
-mPrg
->>>>>>
-Attribute VB_Name = "mPrg"
-Option Explicit
-
-Sub ReCalc()
-    Dim wb As Workbook
-    Dim FileToOpen As String
-    Set wb = ThisWorkbook
-    
-    wb.Sheets(HOME_PAGE_NAME).EnableCalculation = False
-    
-    FileToOpen = wb.Sheets(SETUP_PAGE_NAME).Range(FEMALE_FILE_NAME_ADR)
-    
-    UpdateHistoryFromFile wb, FileToOpen
-    GetUserStat wb.Sheets(RAW_DATA_SHEET), UserStat, BadUserList, STA_USER_FEM
-    WriteResultUsers wb.Sheets(STA_USER_FEM), UserStat
-    WriteBadUsers wb.Sheets(BAD_USER_FEM), BadUserList
-
-    FileToOpen = wb.Sheets(SETUP_PAGE_NAME).Range(MALE_FILE_NAME_ADR)
-    UpdateHistoryFromFile wb, FileToOpen
-    GetUserStat wb.Sheets(RAW_DATA_SHEET), UserStat, BadUserList, STA_USER_MAL
-    WriteResultUsers wb.Sheets(STA_USER_MAL), UserStat
-    WriteBadUsers wb.Sheets(BAD_USER_MAL), BadUserList
-
-    FileToOpen = wb.Sheets(SETUP_PAGE_NAME).Range(SMAIL_FILE_NAME_ADR)
-    UpdateHistoryFromFile wb, FileToOpen
-    GetUserStat wb.Sheets(RAW_DATA_SHEET), UserStat, BadUserList, STA_USER_SML
-    WriteResultUsers wb.Sheets(STA_USER_SML), UserStat
-    WriteBadUsers wb.Sheets(BAD_USER_SML), BadUserList
-    
-'    WriteCommonResult wb.Sheets(STA_USER_TOT)
-    
-    wb.Sheets(HOME_PAGE_NAME).EnableCalculation = True
-    Application.Calculate
-    
-    
-End Sub
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub ResetTotslUsers()
-Attribute ResetTotslUsers.VB_Description = "Macro recorded 23.10.00 by Nickolai Garbuz"
-Attribute ResetTotslUsers.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro1 Macro
-' Macro recorded 23.10.00 by Nickolai Garbuz
-'
-
-'
-    With Worksheets("Total_users")
-        Dim EndLine As Variant
-        .Activate
-        EndLine = GetLinesCount(.Range("A2")) + 1
-        .Range("A" & EndLine & ":" & "W" & EndLine).Select
-        EndLine = EndLine + 1
-        Selection.Copy
-        .Range("A" & (EndLine)).Select
-        .Paste
-    End With
-    Worksheets("HomePage").Activate
-    Dim ChObj As ChartObject
-    With Worksheets("HomePage")
-        For Each ChObj In .Charts
-            If ChObj.Name = "Users Stat" Then
-                ChObj.SetSourceData Source:=Sheets("Total_Users").Range("A2:A13,C2:E13" _
-        ), PlotBy:=xlColumns
-            End If
-        Next ChObj
-    End With
-End Sub
-Sub Macro2()
-Attribute Macro2.VB_Description = "Macro recorded 23.10.00 by Nickolai Garbuz"
-Attribute Macro2.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro2 Macro
-' Macro recorded 23.10.00 by Nickolai Garbuz
-'
-
-'
-    Dim ChObj As ChartObject
-    With Worksheets("HomePage")
-        For Each ChObj In .Charts
-            If ChObj.Name = "Users Stat" Then
-                ChObj.SetSourceData Source:=Sheets("Total_Users").Range("A2:A13,C2:E13" _
-        ), PlotBy:=xlColumns
-            End If
-    End With
-    ActiveSheet.ChartObjects("Chart 12").Activate
-    ActiveChart.PlotArea.Select
-    ActiveChart
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module2
->>>>>>
-Attribute VB_Name = "Module2"
-Function make_ref(shn As String, cn As String)
-    Dim a As Object
-    a = Sheets(shn).Range(cn)
-    make_ref = a.Value
-End Function
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub make_ref()
-Attribute make_ref.VB_Description = "Macro recorded 04.11.99 by Oleg Tabarovsky"
-Attribute make_ref.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' make_ref Macro
-' Macro recorded 04.11.99 by Oleg Tabarovsky
-'
-
-'
-    Range("H33").Select
-    Application.CommandBars("Stop Recording").Visible = False
-    Range("H27").Select
-    ActiveCell.FormulaR1C1 = "=make_ref(R[-1]C[-7],R[-18]C[-6])"
-    Range("H27").Select
-    ActiveCell.FormulaR1C1 = "=make_ref(R[-1]C[-7],R[-18]C[-6])"
-    Range("H27").Select
-    ActiveCell.FormulaR1C1 = "=make_ref(R[-1]C[-7],R[-18]C[-6])"
-    Range("H27").Select
-    ActiveCell.FormulaR1C1 = "=make_ref(R[-1]C[-7],R[-18]C[-6])"
-    Windows("test1.xls").Activate
-    Range("H4:I4").Select
-    Selection.NumberFormat = "General"
-    Range("H4").Select
-    ActiveCell.FormulaR1C1 = "=RC[-4]"
-    ActiveCell.FormulaR1C1 = "=R[1]C[-4]"
-    Range("H4").Select
-    ActiveCell.FormulaR1C1 = "=R[2]C[-4]"
-    Range("H6").Select
-    Windows("Book1").Activate
-    Range("H27").Select
-    Sheets("GL").Select
-    Range("B9").Select
-    Sheets("�alculator").Select
-    Range("H27").Select
-    ActiveCell.FormulaR1C1 = "=make_ref(R[-1]C[-7],""B9"")"
-    ActiveCell.FormulaR1C1 = "=make_ref(R[-1]C[-7],R[-18]C[-6])"
-    Range("G25").Select
-    ActiveCell.FormulaR1C1 = "b9"
-    Range("H27").Select
-    ActiveCell.FormulaR1C1 = "=make_ref(R[-1]C[-7],R[-2]C[-1])"
-    Range("H27").Select
-    ActiveCell.FormulaR1C1 = "=make_ref(R[-1]C[-7],R[-2]C[-1])"
-    Range("H27").Select
-    ActiveCell.FormulaR1C1 = "=make_ref(R[-1]C[-7],R[-2]C[-1])"
-    Range("H27").Select
-    ActiveCell.FormulaR1C1 = "=make_ref(R[-1]C[-7],R[-2]C[-1])"
-    Range("G25").Select
-    Selection.ClearContents
-    Range("H27").Select
-    Selection.ClearContents
-    Range("E26").Select
-    ActiveWindow.SmallScroll Down:=-7
-    Range("D13").Select
-    ActiveWindow.SmallScroll Down:=5
-    Range("D40").Select
-    ActiveWindow.SmallScroll Down:=13
-    Range("D51").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-36]C,R[-36]C,HLOOKUP(R[-42]C,R[18]C[-3]:R[19]C[28],2))"
-    Range("D51").Select
-    ActiveWindow.SmallScroll Down:=-7
-    Range("A27").Select
-    ActiveWindow.SmallScroll Down:=-8
-    Range("A27").Select
-    ActiveCell.FormulaR1C1 = "A81"
-    Range("B27").Select
-    ActiveWindow.SmallScroll Down:=14
-    Range("D51").Select
-    ActiveWindow.SmallScroll Down:=-27
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-36]C,R[-36]C,HLOOKUP(R[-42]C,HLOOKUP(R[-38]C,R[-25]C[-3]:R[-25]C[1],2),2))"
-    Range("D52").Select
-    ActiveWindow.SmallScroll Down:=8
-    Range("D51").Select
-    ActiveWindow.SmallScroll Down:=-6
-    Range("A27").Select
-    ActiveCell.FormulaR1C1 = "A81:F82"
-    Range("E27").Select
-    ActiveWindow.SmallScroll Down:=34
-    Range("D51").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-36]C,R[-36]C,HLOOKUP(R[-42]C,HLOOKUP(R[-38]C,R[-25]C[-3]:R[-24]C[1],2),2))"
-    Range("D52").Select
-    ActiveWindow.SmallScroll Down:=1
-    Range("G37").Select
-    ActiveWindow.SmallScroll Down:=-8
-    Range("D15").Select
-    Selection.ClearContents
-    Range("G24").Select
-    ActiveWindow.SmallScroll Down:=15
-    Range("D51").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-36]C,R[-36]C,HLOOKUP(R[-42]C,INDIRECT(HLOOKUP(R[-38]C,R[-25]C[-3]:R[-24]C[1],2)),2))"
-    Range("I40").Select
-    ActiveCell.FormulaR1C1 = _
-        "=INDIRECT(HLOOKUP(R[-27]C[-5],R[-14]C[-8]:R[-13]C[-4],2))"
-    Range("I40").Select
-    ActiveCell.FormulaR1C1 = _
-        "=INDIRECT(HLOOKUP(R[-27]C[-5],R[-14]C[-8]:R[-13]C[-4],2))"
-    Range("D13").Select
-    ActiveCell.FormulaR1C1 = "GL"
-    Range("D14").Select
-    ActiveWindow.SmallScroll Down:=15
-    Range("A27").Select
-    ActiveCell.FormulaR1C1 = "A81"
-    Range("I40").Select
-    ActiveWindow.SmallScroll Down:=-2
-    ActiveCell.FormulaR1C1 = _
-        "=INDIRECT(HLOOKUP(R[-27]C[-5],R[-14]C[-8]:R[-13]C[-4],2))"
-    Range("D43").Select
-    ActiveWindow.SmallScroll Down:=2
-    Range("D51").Select
-    ActiveWindow.SmallScroll Down:=-6
-    Range("I40").Select
-    ActiveCell.FormulaR1C1 = _
-        "=SUM(INDIRECT(HLOOKUP(R[-27]C[-5],R[-14]C[-8]:R[-13]C[-4],2)))"
-    Range("A27").Select
-    ActiveCell.FormulaR1C1 = "A81:a83"
-    Range("I40").Select
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-31]C[-5],INDIRECT(HLOOKUP(R[-27]C[-5],R[-14]C[-8]:R[-13]C[-4],2)),2)"
-    Range("G5").Select
-    ActiveWindow.SmallScroll Down:=18
-    Range("I40").Select
-    ActiveWindow.SmallScroll Down:=-2
-    Range("A27").Select
-    ActiveCell.FormulaR1C1 = "A81:f82"
-    Range("A28").Select
-    ActiveWindow.SmallScroll Down:=-16
-    Range("D8").Select
-    ActiveCell.FormulaR1C1 = "768"
-    Range("D9").Select
-    ActiveWindow.SmallScroll Down:=0
-    Range("D8").Select
-    ActiveCell.FormulaR1C1 = "1024"
-    Range("D9").Select
-    ActiveWindow.SmallScroll Down:=29
-    Range("D51").Select
-    ActiveWindow.SmallScroll Down:=-18
-    Range("A27").Select
-    ActiveCell.FormulaR1C1 = "A81:F82"
-    Range("F29").Select
-    ActiveWindow.SmallScroll Down:=26
-    Range("D51").Select
-    ActiveWindow.SmallScroll Down:=9
-    Range("I40").Select
-    Selection.Cut
-    Range("I40").Select
-    Application.CutCopyMode = False
-    Selection.ClearContents
-    Range("D51").Select
-    Selection.Copy
-    Range("D52").Select
-    ActiveSheet.Paste
-    Range("D52").Select
-    Application.CutCopyMode = False
-    Range("D51").Select
-    ActiveWindow.SmallScroll Down:=-21
-    Range("D52").Select
-    ActiveSheet.Paste
-    Range("D52").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-37]C,R[-37]C,HLOOKUP(R[-43]C,INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-25]C[1],2)),2))"
-    Range("D52").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-37]C,R[-37]C,HLOOKUP(R[-43]C,INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-25]C[1],3)),2))"
-    Range("D53").Select
-    ActiveWindow.SmallScroll Down:=30
-    Range("F86").Select
-    ActiveWindow.SmallScroll Down:=-36
-    Rows("28:28").Select
-    Selection.Insert Shift:=xlDown
-    Range("A28").Select
-    ActiveCell.FormulaR1C1 = "A85:F86"
-    Range("D52").Select
-    ActiveWindow.SmallScroll Down:=9
-    Range("D53").Select
-    ActiveWindow.SmallScroll Down:=-8
-    Range("A27").Select
-    ActiveCell.FormulaR1C1 = "A82:F83"
-    Range("A28").Select
-    ActiveCell.FormulaR1C1 = "A86:F87"
-    Range("D53").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-38]C,R[-38]C,HLOOKUP(R[-44]C,INDIRECT(HLOOKUP(R[-40]C,R[-27]C[-3]:R[-25]C[1],3)),2))"
-    Range("D52").Select
-    ActiveWindow.SmallScroll Down:=3
-    Range("D56").Select
-    ActiveCell.FormulaR1C1 = "=IF(R[-39]C,R[-39]C,0)"
-    Range("D56").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-39]C,R[-39]C,HLOOKUP(R[-47]C,INDIRECT(HLOOKUP(R[-43]C,R[-30]C[-3]:R[-28]C[1],2)),2))"
-    Range("D56").Select
-    ActiveWindow.SmallScroll Down:=-19
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-39]C,R[-39]C,HLOOKUP(R[-47]C,INDIRECT(HLOOKUP(R[-42]C,R[-30]C[-3]:R[-28]C[1],2)),2))"
-    Range("D57").Select
-    ActiveWindow.SmallScroll Down:=-15
-    Range("D14").Select
-    ActiveCell.FormulaR1C1 = "GL"
-    Range("D17").Select
-    Selection.ClearContents
-    Range("G24:H24").Select
-    Range("H24").Activate
-    ActiveWindow.SmallScroll Down:=23
-    Range("D53").Select
-    ActiveWindow.SmallScroll Down:=-28
-    Range("D19").Select
-    ActiveWindow.SmallScroll Down:=29
-    Range("D53").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-34]C,R[-34]C,HLOOKUP(R[-44]C,INDIRECT(HLOOKUP(R[-40]C,R[-27]C[-3]:R[-25]C[1],3)),2))"
-    Range("D57").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-40]C,R[-40]C,HLOOKUP(R[-48]C,INDIRECT(HLOOKUP(R[-43]C,R[-31]C[-3]:R[-29]C[1],2)),2))"
-    Range("D56").Select
-    ActiveWindow.SmallScroll Down:=-2
-    Range("D57").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-36]C,R[-36]C,HLOOKUP(R[-48]C,INDIRECT(HLOOKUP(R[-43]C,R[-31]C[-3]:R[-29]C[1],3)),2))"
-    Range("D41").Select
-    ActiveWindow.SmallScroll Down:=-22
-    Range("D40").Select
-    ActiveCell.FormulaR1C1 = _
-        "=(R[23]C/R[-6]C)+IF(R[-25]C,R[-25]C*IF(R[-24]C,R[-24]C+1,1),0)+IF(R[-23]C,R[-23]C*IF(R[-22]C,R[-22]C+1,1),0)"
-    Range("D40").Select
-    ActiveWindow.SmallScroll Down:=-17
-    Range("D41").Select
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-32]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-34]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-22]C,R[-22]C*IF(R[-21]C,R[-21]C,1),0)+IF(R[-20]C,R[-20]C*IF(R[-19]C,R[-19]C,1),0)"
-    ActiveWindow.SmallScroll Down:=18
-    Range("D40").Select
-    ActiveCell.FormulaR1C1 = _
-        "=(R[23]C/R[-6]C)+IF(R[-25]C,R[-25]C*IF(R[-24]C,R[-24]C+1,1),IF(R[-25]C,R[-25]C,HLOOKUP(R[-31]C,INDIRECT(HLOOKUP(R[-27]C,R[-14]C[-3]:R[-13]C[1],2)),2)))+IF(R[-23]C,R[-23]C*IF(R[-22]C,R[-22]C+1,1),0)"
-    Range("D40").Select
-    ActiveCell.FormulaR1C1 = _
-        "=(R[23]C/R[-6]C)+IF(R[-25]C,R[-25]C*IF(R[-24]C,R[-24]C+1,1),IF(R[-25]C,R[-25]C,HLOOKUP(R[-31]C,INDIRECT(HLOOKUP(R[-27]C,R[-14]C[-3]:R[-13]C[1],2)),2)))?R[-23]C R[-23]C*IF(R[-22]C,R[-22]C+1,1)R[-23]C R[-23]C R[-31]C R[-26]C R[-14]C[-3]:R[-12]C[1] 2 "
-    Range("D52").Select
-    ActiveWindow.SmallScroll Down:=-13
-    Range("A29").Select
-    ActiveCell.FormulaR1C1 = "A90"
-    Range("F29").Select
-    ActiveWindow.SmallScroll Down:=17
-    Range("D52").Select
-    ActiveWindow.SmallScroll Down:=7
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-37]C,R[-37]C,HLOOKUP(R[-43]C,INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-25]C[1],2)),2)*INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-25]C[1],3)))"
-    Range("D52").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-37]C,R[-37]C,HLOOKUP(R[-43]C,INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],2)),2)*INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],3)))"
-    Range("D52").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-37]C,R[-37]C,HLOOKUP(R[-43]C,INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],2)),2)*SUM(INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],3))))"
-    Range("D52").Select
-    ActiveWindow.SmallScroll Down:=-2
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-37]C,R[-37]C,HLOOKUP(R[-43]C,INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],2)),2)*INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],3)))"
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-37]C,R[-37]C,HLOOKUP(R[-43]C,INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],2)),2)*INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],4)))"
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-37]C,R[-37]C,HLOOKUP(R[-43]C,INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],2)),2)*(1-INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],4))))"
-    Range("D52").Select
-    ActiveWindow.SmallScroll Down:=4
-    Range("D56").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-39]C,R[-39]C,HLOOKUP(R[-47]C,INDIRECT(HLOOKUP(R[-42]C,R[-30]C[-3]:R[-27]C[1],2)),2)*(1-INDIRECT(HLOOKUP(R[-42]C,R[-30]C[-3]:R[-27]C[1],4))))"
-    Range("D57").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-36]C,R[-36]C,HLOOKUP(R[-48]C,INDIRECT(HLOOKUP(R[-43]C,R[-31]C[-3]:R[-29]C[1],3)),2)*(1-INDIRECT(HLOOKUP(R[-43]C,R[-31]C[-3]:R[-28]C[1],4))))"
-    ActiveWindow.SmallScroll Down:=-17
-    Range("D19").Select
-    Selection.ClearContents
-    Range("D21").Select
-    Selection.ClearContents
-    ActiveWindow.SmallScroll Down:=21
-    Range("D53").Select
-    ActiveCell.FormulaR1C1 = _
-        "=IF(R[-34]C,R[-34]C,HLOOKUP(R[-44]C,INDIRECT(HLOOKUP(R[-40]C,R[-27]C[-3]:R[-25]C[1],3)),2)*(1-INDIRECT(HLOOKUP(R[-40]C,R[-27]C[-3]:R[-24]C[1],4))))"
-    Range("G53:G54").Select
-    Range("G54").Activate
-    ActiveWindow.SmallScroll Down:=37
-    Range("H91").Select
-    ActiveWindow.SmallScroll Down:=2
-    Range("A96").Select
-    Sheets("GL").Select
-    ActiveWindow.SelectedSheets.Delete
-    Sheets("MTU").Select
-    ActiveWindow.SelectedSheets.Delete
-    ActiveWindow.SmallScroll Down:=-61
-    Range("A24:E26").Select
-    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
-    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
-    With Selection.Borders(xlEdgeLeft)
-        .LineStyle = xlContinuous
-        .Weight = xlMedium
-        .ColorIndex = xlAutomatic
-    End With
-    With Selection.Borders(xlEdgeTop)
-        .LineStyle = xlContinuous
-        .Weight = xlMedium
-        .ColorIndex = xlAutomatic
-    End With
-    With Selection.Borders(xlEdgeBottom)
-        .LineStyle = xlContinuous
-        .Weight = xlMedium
-        .ColorIndex = xlAutomatic
-    End With
-    With Selection.Borders(xlEdgeRight)
-        .LineStyle = xlContinuous
-        .Weight = xlMedium
-        .ColorIndex = xlAutomatic
-    End With
-    Selection.Borders(xlInsideVertical).LineStyle = xlNone
-    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
-    Range("A25").Select
-    ActiveCell.FormulaR1C1 = "Golden Line"
-    Range("E26").Select
-    ActiveWindow.SmallScroll Down:=-12
-    Range("D8").Select
-    ActiveCell.FormulaR1C1 = "64"
-    Rows("9:9").Select
-    Selection.EntireRow.Hidden = True
-    Range("A7:D8").Select
-    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
-    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
-    With Selection.Borders(xlEdgeLeft)
-        .LineStyle = xlContinuous
-        .Weight = xlMedium
-        .ColorIndex = xlAutomatic
-    End With
-    With Selection.Borders(xlEdgeTop)
-        .LineStyle = xlContinuous
-        .Weight = xlMedium
-        .ColorIndex = xlAutomatic
-    End With
-    With Selection.Borders(xlEdgeBottom)
-        .LineStyle = xlContinuous
-        .Weight = xlMedium
-        .ColorIndex = xlAutomatic
-    End With
-    With Selection.Borders(xlEdgeRight)
-        .LineStyle = xlContinuous
-        .Weight = xlMedium
-        .ColorIndex = xlAutomatic
-    End With
-    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
-    Range("D14").Select
-    Selection.ClearContents
-    Range("D21").Select
-    ActiveCell.FormulaR1C1 = "0"
-    Range("E22").Select
-    ActiveWindow.SmallScroll Down:=13
-    Range("D17").Select
-    ActiveCell.FormulaR1C1 = "0"
-    Range("D40").Select
-    ActiveWindow.SmallScroll Down:=15
-    Range("D56").Select
-    ActiveWindow.SmallScroll Down:=-17
-    Range("D17").Select
-    ActiveCell.FormulaR1C1 = "1"
-    Range("D21").Select
-    ActiveCell.FormulaR1C1 = "1"
-    Range("E22").Select
-    ActiveWindow.SmallScroll Down:=17
-    Range("D40").Select
-    ActiveCell.FormulaR1C1 = _
-        "=(R[23]C/R[-6]C)+IF(R[-25]C,R[-25]C*IF(R[-24]C,R[-24]C+1,1),IF(R[-25]C,R[-25]C,HLOOKUP(R[-31]C,INDIRECT(HLOOKUP(R[-27]C,R[-14]C[-3]:R[-13]C[1],2)),2)))LR[-23]C R[-23]C*IF(R[-22]C,R[-22]C+1,1))R[-23]C R[-23]C R[-31]C R[-26]C R[-14]C[-3]:R[-12]C[1] 2 "
-    Range("D41").Select
-    ActiveCell.FormulaR1C1 = _
-        "=CEILING(HLOOKUP(R[-32]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-34]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-22]C,R[-22]C*IF(R[-21]C,R[-21]C,1),0)+IF(R[-20]C,R[-20]C*IF(R[-19]C,R[-19]C,1),0),1)"
-    Range("D44").Select
-    ActiveCell.FormulaR1C1 = "=CEILING(R[4]C+R[8]C+R[12]C,1)"
-    Range("D45").Select
-    ActiveCell.FormulaR1C1 = "=CEILING(R[4]C+R[8]C+R[12]C,1)"
-    Range("D41").Select
-    ActiveWindow.ScrollRow = 20
-    ActiveWindow.ScrollRow = 13
-    ActiveWindow.SmallScroll Down:=17
-    Range("D41").Select
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-32]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-34]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-22]C,R[-22]C*IF(R[-21]C,R[-21]C,1),IF(R[-22]C,R[-22]C,HLOOKUP(R[-32]C,INDIRECT(HLOOKUP(R[-28]C,R[-15]C[-3]:R[-13]C[1],3)),2))))"
-    Range("D41").Select
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-32]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-34]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-22]C,R[-22]C*IF(R[-21]C,R[-21]C,1),IF(R[-22]C,R[-22]C,HLOOKUP(R[-32]C,INDIRECT(HLOOKUP(R[-28]C,R[-15]C[-3]:R[-13]C[1],3)),2))))"
-    Range("D41").Select
-    ActiveWindow.LargeScroll Down:=-1
-    Range("D21").Select
-    ActiveCell.FormulaR1C1 = "2"
-    Range("E22").Select
-    ActiveWindow.SmallScroll Down:=14
-    Range("D21").Select
-    ActiveCell.FormulaR1C1 = "1"
-    Range("E23").Select
-    ActiveWindow.SmallScroll Down:=-8
-    Range("D16").Select
-    Selection.ClearContents
-    Range("D18").Select
-    Selection.ClearContents
-    Range("G21").Select
-    ActiveWindow.SmallScroll Down:=23
-    Range("D48").Select
-    ActiveCell.FormulaR1C1 = "=CEILING(R[15]C/R[-14]C*IF(R[-15]C,1-R[-15]C,1),1)"
-    Range("D49").Select
-    ActiveCell.FormulaR1C1 = "=CEILING(R[-8]C*IF(R[-16]C,1-R[-16]C,1),1)"
-    Range("D52").Select
-    ActiveCell.FormulaR1C1 = _
-        "=CEILING(IF(R[-37]C,R[-37]C,HLOOKUP(R[-43]C,INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],2)),2)*(1-INDIRECT(HLOOKUP(R[-39]C,R[-26]C[-3]:R[-23]C[1],4)))),1)"
-    Range("D53").Select
-    ActiveCell.FormulaR1C1 = _
-        "=CEILING(IF(R[-34]C,R[-34]C,HLOOKUP(R[-44]C,INDIRECT(HLOOKUP(R[-40]C,R[-27]C[-3]:R[-25]C[1],3)),2)*(1-INDIRECT(HLOOKUP(R[-40]C,R[-27]C[-3]:R[-24]C[1],4)))),1)"
-    Range("D56").Select
-    ActiveCell.FormulaR1C1 = _
-        "=CEILING(IF(R[-39]C,R[-39]C,HLOOKUP(R[-47]C,INDIRECT(HLOOKUP(R[-42]C,R[-30]C[-3]:R[-27]C[1],2)),2)*(1-INDIRECT(HLOOKUP(R[-42]C,R[-30]C[-3]:R[-27]C[1],4)))),1)"
-    Range("D57").Select
-    ActiveCell.FormulaR1C1 = _
-        "=CEILING(IF(R[-36]C,R[-36]C,HLOOKUP(R[-48]C,INDIRECT(HLOOKUP(R[-43]C,R[-31]C[-3]:R[-29]C[1],3)),2)*(1-INDIRECT(HLOOKUP(R[-43]C,R[-31]C[-3]:R[-28]C[1],4)))),1)"
-    Range("D41").Select
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-32]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-34]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-22]C,R[-22]C*IF(R[-21]C,R[-21]C,1),IHLOOKUP(R[-32]C,INDIRECT(HLOOKUP(R[-28]C,R[-15]C[-3]:R[-13]C[1],3)),2))(R[-20]C "
-    Range("D41").Select
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-32]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-34]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-22]C,R[-22]C*IF(R[-21]C,R[-21]C,1),HLOOKUP(R[-32]C,INDIRECT(HLOOKUP(R[-28]C,R[-15]C[-3]:R[-13]C[1],3)),2))"
-    Range("D41").Select
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-32]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-34]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-22]C,R[-22]C*IF(R[-21]C,R[-21]C,1),HLOOKUP(R[-32]C,INDIRECT(HLOOKUP(R[-28]C,R[-15]C[-3]:R[-13]C[1],3)),2))"
-    Range("D41").Select
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-32]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-34]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-22]C,R[-22]C*IF(R[-21]C,R[-21]C,1),HLOOKUP(R[-32]C,INDIRECT(HLOOKUP(R[-28]C,R[-15]C[-3]:R[-12]C[1],3)),2))"
-    Range("D41").Select
-    ActiveWindow.LargeScroll Down:=-1
-    ActiveWindow.SmallScroll Down:=14
-    ActiveWindow.LargeScroll Down:=-1
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-32]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-34]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-22]C,R[-22]C*IF(R[-21]C,R[-21]C,1),HLOOKUP(R[-32]C,INDIRECT(HLOOKUP(R[-28]C,R[-15]C[-3]:R[-12]C[1],3)),2))"
-    ActiveWindow.SmallScroll Down:=12
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-32]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-34]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-22]C,R[-22]C*IF(R[-21]C,R[-21]C,1),HLOOKUP(R[-32]C,INDIRECT(HLOOKUP(R[-28]C,R[-15]C[-3]:R[-12]C[1],2)),2))&R[-20]C "
-    Range("D49").Select
-    ActiveCell.FormulaR1C1 = _
-        "=CEILING(HLOOKUP(R[-40]C,R[21]C[-3]:R[22]C[28],2)*(HLOOKUP(R[-42]C,R[17]C[-2]:R[18]C[10],2)/R[-15]C)*IF(R[-17]C,R[-17]C,1)*IF(R[-16]C,1-R[-16]C,1),1)"
-    Range("D45").Select
-    ActiveWindow.SmallScroll Down:=4
-    Range("D49").Select
-    ActiveWindow.SmallScroll Down:=-27
-    Range("D7").Select
-    ActiveCell.FormulaR1C1 = "100"
-    Range("D8").Select
-    ActiveWindow.SmallScroll Down:=0
-    Range("D7").Select
-    ActiveCell.FormulaR1C1 = "10"
-    Range("D8").Select
-    ActiveWindow.SmallScroll Down:=39
-    Range("D49").Select
-    ActiveWindow.SmallScroll Down:=-4
-    Range("D41").Select
-    ActiveWindow.SmallScroll Down:=17
-    ActiveWindow.LargeScroll Down:=-2
-    ActiveWindow.SmallScroll Down:=24
-    Range("D41").Select
-    ActiveWindow.LargeScroll Down:=-1
-    ActiveWindow.SmallScroll Down:=44
-    ActiveWindow.LargeScroll Down:=-2
-    Rows("30:30").Select
-    Selection.Insert Shift:=xlDown
-    Range("A27").Select
-    ActiveCell.FormulaR1C1 = "A83:F84"
-    Range("A28").Select
-    ActiveCell.FormulaR1C1 = "A87:F88"
-    Range("A29").Select
-    ActiveCell.FormulaR1C1 = "A91"
-    Range("A30").Select
-    ActiveWindow.SmallScroll Down:=17
-    Range("D42").Select
-    ActiveCell.FormulaR1C1 = _
-        "=CEILING(HLOOKUP(R[-33]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-35]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1),1)"
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-33]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-35]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-23]C,R[-23]C*IF(R[-22]C,R[-22]C,1),HLOOKUP(R[-33]C,INDIRECT(HLOOKUP(R[-29]C,R[-16]C[-3]:R[-13]C[1],2)),2))"
-    ActiveWindow.LargeScroll Down:=-1
-    Rows("21:21").Select
-    ActiveWindow.SmallScroll Down:=24
-    Range("D42").Select
-    ActiveWindow.SmallScroll Down:=14
-    ActiveWindow.LargeScroll Down:=-2
-    ActiveWindow.SmallScroll Down:=53
-    ActiveWindow.LargeScroll Down:=-2
-    ActiveWindow.SmallScroll Down:=23
-    Range("D42").Select
-    ActiveCell.FormulaR1C1 = _
-        "=HLOOKUP(R[-33]C,R[29]C[-3]:R[30]C[28],2)*(HLOOKUP(R[-35]C,R[25]C[-2]:R[26]C[10],2)/R[-7]C)*IF(R[-9]C,R[-9]C,1)+IF(R[-23]C,R[-23]C*IF(R[-22]C,R[-22]C,1),HLOOKUP(R[-33]C,INDIRECT(HLOOKUP(R[-29]C,R[-16]C[-3]:R[-13]C[1],3)),2))R[-21]C "
-    Range("D41").Select
-    ActiveCell.FormulaR1C1 = _
-        "=(R[23]C/R[-6]C)+IF(R[-26]C,R[-26]C*IF(R[-25]C,R[-25]C+1,1),IF(R[-26]C,R[-26]C,HLOOKUP(R[-32]C,INDIRECT(HLOOKUP(R[-28]C,R[-15]C[-3]:R[-12]C[1],2)),2)))"
-    Range("D50").Select
-    ActiveWindow.SmallScroll Down:=5
-    Range("G50").Select
-    ActiveWindow.SmallScroll Down:=-26
-    Range("D7").Select
-    ActiveCell.FormulaR1C1 = "720"
-    Range("E7").Select
-    ActiveWindow.SmallScroll Down:=51
-    ActiveWindow.LargeScroll Down:=-2
-    ActiveWindow.SmallScroll Down:=5
-    Range("D8").Select
-    ActiveCell.FormulaR1C1 = "128"
-    Range("E8").Select
-    ActiveWindow.SmallScroll Down:=29
-    ActiveWindow.ScrollRow = 1
-    Range("D8").Select
-    ActiveCell.FormulaR1C1 = "256"
-    Range("G12").Select
-    ActiveWindow.SmallScroll Down:=25
-    ActiveWindow.ScrollRow = 1
-    ActiveWindow.SmallScroll Down:=0
-    Range("D8").Select
-    ActiveCell.FormulaR1C1 = "512"
-    Range("D10").Select
-    ActiveWindow.SmallScroll Down:=31
-    ActiveWindow.ScrollRow = 1
-    Range("D8").Select
-    ActiveCell.FormulaR1C1 = "1024"
-    Range("F12").Select
-    ActiveWindow.SmallScroll Down:=4
-    Range("D8").Select
-    ActiveCell.FormulaR1C1 = "2048"
-    Range("E8").Select
-    ActiveWindow.SmallScroll Down:=42
-    Range("D75").Select
-    ActiveWindow.SmallScroll Down:=1
-    Range("A60:C60").Select
-    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
-    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
-    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
-    Selection.Borders(xlEdgeTop).LineStyle = xlNone
-    With Selection.Borders(xlEdgeBottom)
-        .LineStyle = xlDouble
-        .Weight = xlThick
-        .ColorIndex = xlAutomatic
-    End With
-    Selection.Borders(xlEdgeRight).LineStyle = xlNone
-    Selection.Borders(xlInsideVertical).LineStyle = xlNone
-    Range("D60").Select
-    ActiveCell.FormulaR1C1 = "������ �� ������� ���� ���� �����"
-    Range("D60").Select
-    Selection.Font.Bold = True
-    Range("I60:N60").Select
-    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
-    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
-    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
-    Selection.Borders(xlEdgeTop).LineStyle = xlNone
-    With Selection.Borders(xlEdgeBottom)
-        .LineStyle = xlDouble
-        .Weight = xlThick
-        .ColorIndex = xlAutomatic
-    End With
-    Selection.Borders(xlEdgeRight).LineStyle = xlNone
-    Selection.Borders(xlInsideVertical).LineStyle = xlNone
-    Range("F61").Select
-    ActiveWindow.SmallScroll Down:=-47
-    ChDir "N:\Info\Telecom\Leased-lines"
-    ActiveWorkbook.SaveAs FileName:="N:\Info\Telecom\Leased-lines\Calculator.xls" _
-        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
-        ReadOnlyRecommended:=False, CreateBackup:=False
-    Range("A24").Select
-    Selection.Font.Bold = True
-    Range("A25:E25").Select
-    Selection.Font.Italic = True
-    Range("A26:E26").Select
-    Selection.Font.Bold = True
-    Range("A25:E25").Select
-    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
-    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
-    With Selection.Borders(xlEdgeLeft)
-        .LineStyle = xlContinuous
-        .Weight = xlMedium
-        .ColorIndex = xlAutomatic
-    End With
-    With Selection.Borders(xlEdgeTop)
-        .LineStyle = xlContinuous
-        .Weight = xlThin
-        .ColorIndex = xlAutomatic
-    End With
-    With Selection.Borders(xlEdgeBottom)
-        .LineStyle = xlContinuous
-        .Weight = xlThin
-        .ColorIndex = xlAutomatic
-    End With
-    With Selection.Borders(xlEdgeRight)
-        .LineStyle = xlContinuous
-        .Weight = xlMedium
-        .ColorIndex = xlAutomatic
-    End With
-    Selection.Borders(xlInsideVertical).LineStyle = xlNone
-    Rows("27:29").Select
-    Selection.EntireRow.Hidden = True
-    Range("I31").Select
-    ActiveWindow.SmallScroll Down:=54
-    Rows("62:144").Select
-    Selection.EntireRow.Hidden = True
-    Range("D157").Select
-    ActiveWindow.SmallScroll Down:=-36
-    ActiveWorkbook.Save
-    Application.Dialogs(xlDialogSendMail).Show
-    ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Function ChkIncrease(aRange As Range) As Integer
-    Dim res As Integer
-    Dim areaCount As Long
-    areaCount = aRange.Count
-    res = 0
-    If areaCount > 1 Then
-        For i = 1 To areaCount - 1
-            If aRange(i).Value <= aRange(i + 1).Value Then
-                res = res + 1
-            End If
-        Next i
-    Else
-        res = -1
-    End If
-    
-    If (res = areaCount - 1) Then
-        ChkIncrease = 1
-    Else
-        ChkIncrease = 0
-    End If
-End Function
-
-Function ChkDecrease(aRange As Range) As Integer
-    Dim res As Integer
-    Dim areaCount As Long
-    areaCount = aRange.Count
-    res = 0
-    If areaCount > 1 Then
-        For i = 1 To areaCount - 1
-            If aRange(i).Value >= aRange(i + 1).Value Then
-                res = res + 1
-            End If
-        Next i
-    Else
-        res = -1
-    End If
-    
-    If (res = areaCount - 1) Then
-        ChkDecrease = 1
-    Else
-        ChkDecrease = 0
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Function CheckRange(aRange As Range) As Integer
-    Dim res As Integer
-    Dim areaCount As Long
-    areaCount = aRange.Count
-    res = 0
-    If areaCount > 1 Then
-        For i = 1 To areaCount - 1
-            If aRange(i).Value <= aRange(i + 1).Value Then
-                res = res + 1
-            End If
-        Next i
-    Else
-        res = -1
-    End If
-    
-    If (res = areaCount - 1) Then
-        CheckRange = 1
-    Else
-        CheckRange = 0
-    End If
-End Function
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Function ChkIncrease(aRange As Range) As Integer
-    Dim res As Integer
-    Dim areaCount As Long
-    areaCount = aRange.Count
-    res = 0
-    If areaCount > 1 Then
-        For i = 1 To areaCount - 1
-            If aRange(i).Value <= aRange(i + 1).Value Then
-                res = res + 1
-            End If
-        Next i
-    Else
-        res = -1
-    End If
-    
-    If (res = areaCount - 1) Then
-        ChkIncrease = 1
-    Else
-        ChkIncrease = 0
-    End If
-End Function
-
-Function ChkDecrease(aRange As Range) As Integer
-    Dim res As Integer
-    Dim areaCount As Long
-    areaCount = aRange.Count
-    res = 0
-    If areaCount > 1 Then
-        For i = 1 To areaCount - 1
-            If aRange(i).Value >= aRange(i + 1).Value Then
-                res = res + 1
-            End If
-        Next i
-    Else
-        res = -1
-    End If
-    
-    If (res = areaCount - 1) Then
-        ChkDecrease = 1
-    Else
-        ChkDecrease = 0
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-Sub Click()
-
-End Sub
-
-
-Sub SaveSettings()
-    ThisWorkbook.Save
-End Sub
-
-Sub gotohome()
-    Sheets("Home").Select
-    Range("A1").Select
-End Sub
-
-Sub gotolist()
-    Sheets("SiteList").Select
-    Range("A1").Select
-End Sub
-
-Private Sub Workbook_Open()
-    MsgBox ("ok")
-    gotohome
-End Sub
-
-Option Explicit
-
-Sub DeleteSite()
-    MsgBox "�� �������", vbOKCancel, "��������"
-End Sub
-
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Module2
->>>>>>
-Attribute VB_Name = "Module2"
-Option Explicit
-
-Sub Add_Tarif()
-    Dim s As String
-    s = InputBox("������� ����� ���", "���������� ������")
-End Sub
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-AppEv_ISP
->>>>>>
-Attribute VB_Name = "AppEv_ISP"
-
-
-Sub dummy()
-Attribute dummy.VB_ProcData.VB_Invoke_Func = " \n14"
-
-End Sub
-
-Sub Set_Default_Hosting()
-Attribute Set_Default_Hosting.VB_ProcData.VB_Invoke_Func = " \n14"
-    With ThisWorkbook.Worksheets("Prices.Hosting")
-        .Range("C5") = 1
-        .Range("c18") = 1
-        .Range("c23") = 1
-    End With
-End Sub
-
-Sub Set_Default_Intel()
-Attribute Set_Default_Intel.VB_ProcData.VB_Invoke_Func = " \n14"
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            .Range("b9") = 1
-            .Range("f15") = 1
-            .Range("b21") = 1
-            .Range("b30") = 1
-            .Range("b37") = 1
-            .Range("b45") = 1
-            .Range("b51") = 1
-            .Range("b57") = 1
-        Else
-            .Range("f9") = 1
-            .Range("f15") = 1
-            .Range("f21") = 1
-            .Range("f30") = 1
-            .Range("f37") = 1
-            .Range("f45") = 1
-            .Range("f51") = 1
-            .Range("f57") = 1
-        End If
-    End With
-
-End Sub
-
-Sub evISP_ModelChange()
-Attribute evISP_ModelChange.VB_ProcData.VB_Invoke_Func = " \n14"
-    SetCPUList
-    SetRAMList
-    SetHDDList
-    SetADDList
-    Set_Default_Intel
-End Sub
-
-Sub SetCPUList()
-Attribute SetCPUList.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim NewCbxRange, NewCbxIndex As String
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b10:b12").Address
-            NewCbxIndex = .Name & "!" & .Range("b9").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f10:f11").Address
-            NewCbxIndex = .Name & "!" & .Range("f9").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_CPU")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b16:b16").Address
-            NewCbxIndex = .Name & "!" & .Range("b15").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f16:f17").Address
-            NewCbxIndex = .Name & "!" & .Range("f15").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_CPU_CNT")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-End Sub
-
-Sub SetRAMList()
-Attribute SetRAMList.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim NewCbxRange, NewCbxIndex As String
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b22:b26").Address
-            NewCbxIndex = .Name & "!" & .Range("b21").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f22:f26").Address
-            NewCbxIndex = .Name & "!" & .Range("f21").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_RAM")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-End Sub
-
-Sub SetHDDList()
-Attribute SetHDDList.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim NewCbxRange, NewCbxIndex As String
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b31:b33").Address
-            NewCbxIndex = .Name & "!" & .Range("b30").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f31:f33").Address
-            NewCbxIndex = .Name & "!" & .Range("f30").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_HDD")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b38:b39").Address
-            NewCbxIndex = .Name & "!" & .Range("b37").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f38:f41").Address
-            NewCbxIndex = .Name & "!" & .Range("f37").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_HDD_CNT")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-End Sub
-
-Sub SetADDList()
-Attribute SetADDList.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim NewCbxRange, NewCbxIndex As String
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b46:b47").Address
-            NewCbxIndex = .Name & "!" & .Range("b45").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f46:f47").Address
-            NewCbxIndex = .Name & "!" & .Range("f45").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_CDRW")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b52:b53").Address
-            NewCbxIndex = .Name & "!" & .Range("b51").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f52:f52").Address
-            NewCbxIndex = .Name & "!" & .Range("f51").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_SVGA")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b58:b59").Address
-            NewCbxIndex = .Name & "!" & .Range("b57").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f58:f59").Address
-            NewCbxIndex = .Name & "!" & .Range("f57").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_ETH2")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-End Sub
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag lengthProject Name : 'VBAProject'
-Quirk - duff tag lengthProject Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Home_Click()
-Attribute Home_Click.VB_Description = "Macro recorded 11/04/2001 by Nickolai Garbuz"
-Attribute Home_Click.VB_ProcData.VB_Invoke_Func = " \n14"
-    Sheets("Home").Select
-    Range("A1").Select
-End Sub
-Sub CPriceDraft_Click()
-    Sheets("Price.Draft").Select
-    Range("A1").Select
-End Sub
-Sub COperSetup_Click()
-    Sheets("Operators.Setup").Select
-    Range("A1").Select
-End Sub
-Sub COperPrice_Click()
-    Sheets("Operators.Price").Select
-    Range("A1").Select
-End Sub
-Sub CDealerSetup_Click()
-    Sheets("Dealers.Setup").Select
-    Range("A1").Select
-End Sub
-Sub CDealerPrice_Click()
-    Sheets("Dealers.Price").Select
-    Range("A1").Select
-End Sub
-
-Sub CClientSetup_Click()
-    Sheets("Corporate.Setup").Select
-    Range("A1").Select
-End Sub
-Sub CClientGPL_Click()
-    Sheets("Corporate.GPL").Select
-    Range("A1").Select
-End Sub
-Sub CClientGPL10_Click()
-    Sheets("Corporate.GPL-10").Select
-    Range("A1").Select
-End Sub
-Sub CClientGPL20_Click()
-    Sheets("Corporate.GPL-20").Select
-    Range("A1").Select
-End Sub
-
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-Const SCAN_ROW As String = "C3"
-Const PRICE_COUNT As Integer = 4
-Const PROFIT_TABLE As String = "AA1"
-Const CORRECTION_TABLE As String = "M1"
-
-
-Sub RecalcRouting()
-    Dim Src As Range
-    Dim Dst As Range
-    Dim Tst As Range
-    Dim Scan As Range
-    Dim Disp As Range
-    Dim i As Integer
-    Dim j As Integer
-    Dim IgnBad As Boolean
-    
-    Set Scan = ThisWorkbook.Worksheets("CompactPrices").Range(SCAN_ROW)
-    
-   Application.Calculation = xlCalculationManual
-   
-    With ThisWorkbook.Worksheets("Function")
-        Set Disp = .Range("Display")
-        
-        Disp = GetLinesCount(Scan)
-        IgnBad = .Range("NoBad")
-        
-        If .Range("RestRout") = True Then
-            Disp = Disp * 2
-            RestoreRouting IgnBad, Disp
-        End If
-    End With
-    
-    With ThisWorkbook.Worksheets("CompactPrices")
-        Set Scan = .Range(SCAN_ROW)
-        
-        While Scan <> ""
-            
-            Disp = Disp - 1
-            
-            Set Src = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, 0)
-            Set Tst = .Range(CORRECTION_TABLE).Offset(Scan.Row - 1, 0)
-            
-' ������ ����������� �� ����
-            For i = 0 To PRICE_COUNT - 1
-                Src.Offset(0, PRICE_COUNT + i) = "-"
-                If Application.WorksheetFunction.IsNumber(Src.Offset(0, i)) Then
-                    Src.Offset(0, PRICE_COUNT + i) = 4
-                    For j = 0 To PRICE_COUNT - 1
-                        Set Dst = Src.Offset(0, j)
-                        If Src.Offset(0, i).Address <> Dst.Address Then
-                            If Application.WorksheetFunction.IsNumber(Dst) Then
-                                If Tst.Offset(0, i) = Tst.Offset(0, j) Then
-                                    If Src.Offset(0, i) > Dst Then
-                                        Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                                    End If
-                                Else
-                                    If Tst.Offset(0, i) < Tst.Offset(0, j) Then
-                                        Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                                    End If
-                                End If
-                            Else
-                               Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                            End If
-                        End If
-                    Next j
-                End If
-            Next i
-
-' ������������ �����������
-            For i = 0 To PRICE_COUNT - 1
-                Set Src = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, PRICE_COUNT + i)
-                If Src <> "-" Then
-                    For j = PRICE_COUNT - 1 To 0 Step -1
-                        Set Dst = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, PRICE_COUNT + j)
-                        If Dst <> "-" Then
-                            If Src.Address <> Dst.Address Then
-                                If Src = Dst Then
-                                    If Tst.Offset(0, i) = Tst.Offset(0, j) Then
-                                        If i < j Then
-                                            Src = Src - 1
-                                        Else
-                                            Dst = Dst - 1
-                                        End If
-                                    Else
-                                        If Tst.Offset(0, i) < Tst.Offset(0, j) Then
-                                            Src = Src - 1
-                                        Else
-                                            Dst = Dst - 1
-                                        End If
-                                    End If
-                                End If
-                            End If
-                        End If
-                    Next j
-                End If
-            Next i
-
-
-            Set Scan = Scan.Offset(1, 0)
-        Wend
-        With Application
-            .Calculate
-            .Calculation = xlCalculationAutomatic
-        End With
-    End With
-End Sub
-
-Sub RestoreRouting(BadIgnore As Boolean, Disp As Range)
-    Dim Src As Range
-    Dim Dst As Range
-    Dim Scan As Range
-    Dim i As Integer
-    
-    With ThisWorkbook.Worksheets("CompactPrices")
-        Set Scan = .Range(SCAN_ROW)
-        Set Src = .Range(PROFIT_TABLE)
-        Set Dst = .Range(CORRECTION_TABLE)
-        
-        While Scan <> ""
-            Disp = Disp - 1
-            For i = 0 To PRICE_COUNT - 1
-                Dst.Offset(Scan.Row - 1, i) = 1
-            Next i
-            .Calculate
-lChkAgain:
-            For i = 0 To PRICE_COUNT - 1
-                If Application.WorksheetFunction.IsNumber(Src.Offset(Scan.Row - 1, i)) Then
-                    If BadIgnore Then
-                        If Src.Offset(Scan.Row - 1, i) < 0 Then
-                            Dst.Offset(Scan.Row - 1, i) = ""
-                            Application.Calculate
-                        End If
-                    End If
-                Else
-                    Dst.Offset(Scan.Row - 1, i) = ""
-                End If
-            Next i
-                        
-            If BadIgnore Then
-                .Calculate
-                
-                For i = 0 To PRICE_COUNT - 1
-                    If Src.Offset(Scan.Row - 1, i) < 0 Then
-                        GoTo lChkAgain
-                    End If
-                Next i
-            End If
-                        
-            Set Scan = Scan.Offset(1, 0)
-        Wend
-        
-    End With
-End Sub
-
-Function GetLinesCount(r As Range) As Integer
-
-    Dim LinesCount As Integer
-    Dim rr As Range
-
-    Set rr = r
- 
-    LinesCount = 0
-    
-    While rr <> ""
-        LinesCount = LinesCount + 1
-        Set rr = rr.Offset(1, 0)
-    Wend
-    
-    GetLinesCount = LinesCount
-End Function
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-Const SCAN_ROW As String = "C3"
-Const PRICE_COUNT As Integer = 4
-Const PROFIT_TABLE As String = "AA1"
-Const CORRECTION_TABLE As String = "M1"
-
-
-Sub RecalcRouting()
-Attribute RecalcRouting.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim Src As Range
-    Dim Dst As Range
-    Dim Tst As Range
-    Dim Scan As Range
-    Dim Disp As Range
-    Dim i As Integer
-    Dim j As Integer
-    Dim IgnBad As Boolean
-    
-    Set Scan = ThisWorkbook.Worksheets("CompactPrices").Range(SCAN_ROW)
-    
-   Application.Calculation = xlCalculationManual
-   
-    With ThisWorkbook.Worksheets("Function")
-        Set Disp = .Range("Display")
-        
-        Disp = GetLinesCount(Scan)
-        IgnBad = .Range("NoBad")
-        
-        If .Range("RestRout") = True Then
-            Disp = Disp * 2
-            RestoreRouting IgnBad, Disp
-        End If
-    End With
-    
-    With ThisWorkbook.Worksheets("CompactPrices")
-        Set Scan = .Range(SCAN_ROW)
-        
-        While Scan <> ""
-            
-            Disp = Disp - 1
-            
-            Set Src = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, 0)
-            Set Tst = .Range(CORRECTION_TABLE).Offset(Scan.Row - 1, 0)
-            
-' ������ ����������� �� ����
-            For i = 0 To PRICE_COUNT - 1
-                Src.Offset(0, PRICE_COUNT + i) = "-"
-                If Application.WorksheetFunction.IsNumber(Src.Offset(0, i)) Then
-                    Src.Offset(0, PRICE_COUNT + i) = 4
-                    For j = 0 To PRICE_COUNT - 1
-                        Set Dst = Src.Offset(0, j)
-                        If Src.Offset(0, i).Address <> Dst.Address Then
-                            If Application.WorksheetFunction.IsNumber(Dst) Then
-                                If Tst.Offset(0, i) = Tst.Offset(0, j) Then
-                                    If Src.Offset(0, i) > Dst Then
-                                        Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                                    End If
-                                Else
-                                    If Tst.Offset(0, i) < Tst.Offset(0, j) Then
-                                        Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                                    End If
-                                End If
-                            Else
-                               Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                            End If
-                        End If
-                    Next j
-                End If
-            Next i
-
-' ������������ �����������
-            For i = 0 To PRICE_COUNT - 1
-                Set Src = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, PRICE_COUNT + i)
-                If Src <> "-" Then
-                    For j = PRICE_COUNT - 1 To 0 Step -1
-                        Set Dst = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, PRICE_COUNT + j)
-                        If Dst <> "-" Then
-                            If Src.Address <> Dst.Address Then
-                                If Src = Dst Then
-                                    If Tst.Offset(0, i) = Tst.Offset(0, j) Then
-                                        If i < j Then
-                                            Src = Src - 1
-                                        Else
-                                            Dst = Dst - 1
-                                        End If
-                                    Else
-                                        If Tst.Offset(0, i) < Tst.Offset(0, j) Then
-                                            Src = Src - 1
-                                        Else
-                                            Dst = Dst - 1
-                                        End If
-                                    End If
-                                End If
-                            End If
-                        End If
-                    Next j
-                End If
-            Next i
-
-
-            Set Scan = Scan.Offset(1, 0)
-        Wend
-        With Application
-            .Calculate
-            .Calculation = xlCalculationAutomatic
-        End With
-    End With
-End Sub
-
-Sub RestoreRouting(BadIgnore As Boolean, Disp As Range)
-Attribute RestoreRouting.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim Src As Range
-    Dim Dst As Range
-    Dim Scan As Range
-    Dim i As Integer
-    
-    With ThisWorkbook.Worksheets("CompactPrices")
-        Set Scan = .Range(SCAN_ROW)
-        Set Src = .Range(PROFIT_TABLE)
-        Set Dst = .Range(CORRECTION_TABLE)
-        
-        While Scan <> ""
-            Disp = Disp - 1
-            For i = 0 To PRICE_COUNT - 1
-                Dst.Offset(Scan.Row - 1, i) = 1
-            Next i
-            .Calculate
-lChkAgain:
-            For i = 0 To PRICE_COUNT - 1
-                If Application.WorksheetFunction.IsNumber(Src.Offset(Scan.Row - 1, i)) Then
-                    If BadIgnore Then
-                        If Src.Offset(Scan.Row - 1, i) < 0 Then
-                            Dst.Offset(Scan.Row - 1, i) = ""
-                            Application.Calculate
-                        End If
-                    End If
-                Else
-                    Dst.Offset(Scan.Row - 1, i) = ""
-                End If
-            Next i
-                        
-            If BadIgnore Then
-                .Calculate
-                
-                For i = 0 To PRICE_COUNT - 1
-                    If Src.Offset(Scan.Row - 1, i) < 0 Then
-                        GoTo lChkAgain
-                    End If
-                Next i
-            End If
-                        
-            Set Scan = Scan.Offset(1, 0)
-        Wend
-        
-    End With
-End Sub
-
-Function GetLinesCount(r As Range) As Integer
-Attribute GetLinesCount.VB_ProcData.VB_Invoke_Func = " \n14"
-
-    Dim LinesCount As Integer
-    Dim rr As Range
-
-    Set rr = r
- 
-    LinesCount = 0
-    
-    While rr <> ""
-        LinesCount = LinesCount + 1
-        Set rr = rr.Offset(1, 0)
-    Wend
-    
-    GetLinesCount = LinesCount
-End Function
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-Const SCAN_ROW As String = "C3"
-Const PRICE_COUNT As Integer = 4
-Const PROFIT_TABLE As String = "AA1"
-Const CORRECTION_TABLE As String = "M1"
-
-
-Sub RecalcRouting()
-Attribute RecalcRouting.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim Src As Range
-    Dim Dst As Range
-    Dim Tst As Range
-    Dim Scan As Range
-    Dim Disp As Range
-    Dim i As Integer
-    Dim j As Integer
-    Dim IgnBad As Boolean
-    
-    Set Scan = ThisWorkbook.Worksheets("CompactPrices").Range(SCAN_ROW)
-    
-   Application.Calculation = xlCalculationManual
-   
-    With ThisWorkbook.Worksheets("Function")
-        Set Disp = .Range("Display")
-        
-        Disp = GetLinesCount(Scan)
-        IgnBad = .Range("NoBad")
-        
-        If .Range("RestRout") = True Then
-            Disp = Disp * 2
-            RestoreRouting IgnBad, Disp
-        End If
-    End With
-    
-    With ThisWorkbook.Worksheets("CompactPrices")
-        Set Scan = .Range(SCAN_ROW)
-        
-        While Scan <> ""
-            
-            Disp = Disp - 1
-            
-            Set Src = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, 0)
-            Set Tst = .Range(CORRECTION_TABLE).Offset(Scan.Row - 1, 0)
-            
-' ������ ����������� �� ����
-            For i = 0 To PRICE_COUNT - 1
-                Src.Offset(0, PRICE_COUNT + i) = "-"
-                If Application.WorksheetFunction.IsNumber(Src.Offset(0, i)) Then
-                    Src.Offset(0, PRICE_COUNT + i) = 4
-                    For j = 0 To PRICE_COUNT - 1
-                        Set Dst = Src.Offset(0, j)
-                        If Src.Offset(0, i).Address <> Dst.Address Then
-                            If Application.WorksheetFunction.IsNumber(Dst) Then
-                                If Tst.Offset(0, i) = Tst.Offset(0, j) Then
-                                    If Src.Offset(0, i) > Dst Then
-                                        Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                                    End If
-                                Else
-                                    If Tst.Offset(0, i) < Tst.Offset(0, j) Then
-                                        Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                                    End If
-                                End If
-                            Else
-                               Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                            End If
-                        End If
-                    Next j
-                End If
-            Next i
-
-' ������������ �����������
-            For i = 0 To PRICE_COUNT - 1
-                Set Src = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, PRICE_COUNT + i)
-                If Src <> "-" Then
-                    For j = PRICE_COUNT - 1 To 0 Step -1
-                        Set Dst = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, PRICE_COUNT + j)
-                        If Dst <> "-" Then
-                            If Src.Address <> Dst.Address Then
-                                If Src = Dst Then
-                                    If Tst.Offset(0, i) = Tst.Offset(0, j) Then
-                                        If i < j Then
-                                            Src = Src - 1
-                                        Else
-                                            Dst = Dst - 1
-                                        End If
-                                    Else
-                                        If Tst.Offset(0, i) < Tst.Offset(0, j) Then
-                                            Src = Src - 1
-                                        Else
-                                            Dst = Dst - 1
-                                        End If
-                                    End If
-                                End If
-                            End If
-                        End If
-                    Next j
-                End If
-            Next i
-
-
-            Set Scan = Scan.Offset(1, 0)
-        Wend
-        With Application
-            .Calculate
-            .Calculation = xlCalculationAutomatic
-        End With
-    End With
-End Sub
-
-Sub RestoreRouting(BadIgnore As Boolean, Disp As Range)
-Attribute RestoreRouting.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim Src As Range
-    Dim Dst As Range
-    Dim Scan As Range
-    Dim i As Integer
-    
-    With ThisWorkbook.Worksheets("CompactPrices")
-        Set Scan = .Range(SCAN_ROW)
-        Set Src = .Range(PROFIT_TABLE)
-        Set Dst = .Range(CORRECTION_TABLE)
-        
-        While Scan <> ""
-            Disp = Disp - 1
-            For i = 0 To PRICE_COUNT - 1
-                Dst.Offset(Scan.Row - 1, i) = 1
-            Next i
-            .Calculate
-lChkAgain:
-            For i = 0 To PRICE_COUNT - 1
-                If Application.WorksheetFunction.IsNumber(Src.Offset(Scan.Row - 1, i)) Then
-                    If BadIgnore Then
-                        If Src.Offset(Scan.Row - 1, i) < 0 Then
-                            Dst.Offset(Scan.Row - 1, i) = ""
-                            Application.Calculate
-                        End If
-                    End If
-                Else
-                    Dst.Offset(Scan.Row - 1, i) = ""
-                End If
-            Next i
-                        
-            If BadIgnore Then
-                .Calculate
-                
-                For i = 0 To PRICE_COUNT - 1
-                    If Src.Offset(Scan.Row - 1, i) < 0 Then
-                        GoTo lChkAgain
-                    End If
-                Next i
-            End If
-                        
-            Set Scan = Scan.Offset(1, 0)
-        Wend
-        
-    End With
-End Sub
-
-Function GetLinesCount(r As Range) As Integer
-Attribute GetLinesCount.VB_ProcData.VB_Invoke_Func = " \n14"
-
-    Dim LinesCount As Integer
-    Dim rr As Range
-
-    Set rr = r
- 
-    LinesCount = 0
-    
-    While rr <> ""
-        LinesCount = LinesCount + 1
-        Set rr = rr.Offset(1, 0)
-    Wend
-    
-    GetLinesCount = LinesCount
-End Function
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-Const SCAN_ROW As String = "C3"
-Const PRICE_COUNT As Integer = 4
-Const PROFIT_TABLE As String = "AA1"
-Const CORRECTION_TABLE As String = "M1"
-
-
-Sub RecalcRouting()
-Attribute RecalcRouting.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim Src As Range
-    Dim Dst As Range
-    Dim Tst As Range
-    Dim Scan As Range
-    Dim Disp As Range
-    Dim i As Integer
-    Dim j As Integer
-    Dim IgnBad As Boolean
-    
-    Set Scan = ThisWorkbook.Worksheets("CompactPrices").Range(SCAN_ROW)
-    
-   Application.Calculation = xlCalculationManual
-   
-    With ThisWorkbook.Worksheets("Function")
-        Set Disp = .Range("Display")
-        
-        Disp = GetLinesCount(Scan)
-        IgnBad = .Range("NoBad")
-        
-        If .Range("RestRout") = True Then
-            Disp = Disp * 2
-            RestoreRouting IgnBad, Disp
-        End If
-    End With
-    
-    With ThisWorkbook.Worksheets("CompactPrices")
-        Set Scan = .Range(SCAN_ROW)
-        
-        While Scan <> ""
-            
-            Disp = Disp - 1
-            
-            Set Src = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, 0)
-            Set Tst = .Range(CORRECTION_TABLE).Offset(Scan.Row - 1, 0)
-            
-' ������ ����������� �� ����
-            For i = 0 To PRICE_COUNT - 1
-                Src.Offset(0, PRICE_COUNT + i) = "-"
-                If Application.WorksheetFunction.IsNumber(Src.Offset(0, i)) Then
-                    Src.Offset(0, PRICE_COUNT + i) = 4
-                    For j = 0 To PRICE_COUNT - 1
-                        Set Dst = Src.Offset(0, j)
-                        If Src.Offset(0, i).Address <> Dst.Address Then
-                            If Application.WorksheetFunction.IsNumber(Dst) Then
-                                If Tst.Offset(0, i) = Tst.Offset(0, j) Then
-                                    If Src.Offset(0, i) > Dst Then
-                                        Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                                    End If
-                                Else
-                                    If Tst.Offset(0, i) < Tst.Offset(0, j) Then
-                                        Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                                    End If
-                                End If
-                            Else
-                               Src.Offset(0, PRICE_COUNT + i) = Src.Offset(0, PRICE_COUNT + i) - 1
-                            End If
-                        End If
-                    Next j
-                End If
-            Next i
-
-' ������������ �����������
-            For i = 0 To PRICE_COUNT - 1
-                Set Src = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, PRICE_COUNT + i)
-                If Src <> "-" Then
-                    For j = PRICE_COUNT - 1 To 0 Step -1
-                        Set Dst = .Range(PROFIT_TABLE).Offset(Scan.Row - 1, PRICE_COUNT + j)
-                        If Dst <> "-" Then
-                            If Src.Address <> Dst.Address Then
-                                If Src = Dst Then
-                                    If Tst.Offset(0, i) = Tst.Offset(0, j) Then
-                                        If i < j Then
-                                            Src = Src - 1
-                                        Else
-                                            Dst = Dst - 1
-                                        End If
-                                    Else
-                                        If Tst.Offset(0, i) < Tst.Offset(0, j) Then
-                                            Src = Src - 1
-                                        Else
-                                            Dst = Dst - 1
-                                        End If
-                                    End If
-                                End If
-                            End If
-                        End If
-                    Next j
-                End If
-            Next i
-
-
-            Set Scan = Scan.Offset(1, 0)
-        Wend
-        With Application
-            .Calculate
-            .Calculation = xlCalculationAutomatic
-        End With
-    End With
-End Sub
-
-Sub RestoreRouting(BadIgnore As Boolean, Disp As Range)
-Attribute RestoreRouting.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim Src As Range
-    Dim Dst As Range
-    Dim Scan As Range
-    Dim i As Integer
-    
-    With ThisWorkbook.Worksheets("CompactPrices")
-        Set Scan = .Range(SCAN_ROW)
-        Set Src = .Range(PROFIT_TABLE)
-        Set Dst = .Range(CORRECTION_TABLE)
-        
-        While Scan <> ""
-            Disp = Disp - 1
-            For i = 0 To PRICE_COUNT - 1
-                Dst.Offset(Scan.Row - 1, i) = 1
-            Next i
-            .Calculate
-lChkAgain:
-            For i = 0 To PRICE_COUNT - 1
-                If Application.WorksheetFunction.IsNumber(Src.Offset(Scan.Row - 1, i)) Then
-                    If BadIgnore Then
-                        If Src.Offset(Scan.Row - 1, i) < 0 Then
-                            Dst.Offset(Scan.Row - 1, i) = ""
-                            Application.Calculate
-                        End If
-                    End If
-                Else
-                    Dst.Offset(Scan.Row - 1, i) = ""
-                End If
-            Next i
-                        
-            If BadIgnore Then
-                .Calculate
-                
-                For i = 0 To PRICE_COUNT - 1
-                    If Src.Offset(Scan.Row - 1, i) < 0 Then
-                        GoTo lChkAgain
-                    End If
-                Next i
-            End If
-                        
-            Set Scan = Scan.Offset(1, 0)
-        Wend
-        
-    End With
-End Sub
-
-Function GetLinesCount(r As Range) As Integer
-Attribute GetLinesCount.VB_ProcData.VB_Invoke_Func = " \n14"
-
-    Dim LinesCount As Integer
-    Dim rr As Range
-
-    Set rr = r
- 
-    LinesCount = 0
-    
-    While rr <> ""
-        LinesCount = LinesCount + 1
-        Set rr = rr.Offset(1, 0)
-    Wend
-    
-    GetLinesCount = LinesCount
-End Function
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-mForecastPrice
->>>>>>
-Attribute VB_Name = "mForecastPrice"
-Option Explicit
-
-
-Sub Step_4a_SetParentZonePrices()
-    Dim i As Integer
-    Dim k As Integer
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-'        .Application.ScreenUpdating = False
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        i = 0
-        For k = 1 To ListsRange.Count
-            If ListsRange(k, Ofs_InPriceList) <> 1 Then
-                GoTo End_of_For_1
-            End If
-            
-            If ListsRange(k, Ofs_ChkParent) = 1 Then
-                Set DstRange = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3)
-                RestoreParentZonePrice DstRange, idx_PriceIN + i
-            End If
-            
-            i = i + 1
-End_of_For_1:
-        Next k
-        .Application.ScreenUpdating = True
-    End With
-End Sub
-
-Sub Step_4b_SetChildZonePrices()
-    Dim i As Integer
-    Dim k As Integer
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        i = 0
-        For k = 1 To ListsRange.Count
-            If ListsRange(k, Ofs_InPriceList) <> 1 Then
-                GoTo End_of_For_1
-            End If
-            
-            If ListsRange(k, Ofs_ChkChild) = 1 Then
-                Set DstRange = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3)
-                RestoreChildZonePrice DstRange, idx_PriceIN + i
-            End If
-            
-            i = i + 1
-End_of_For_1:
-        Next k
-        .Application.ScreenUpdating = True
-    End With
-End Sub
-
-Sub Step_4c_SetAliasZonePrices()
-    Dim i As Integer
-    Dim k As Integer
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        i = 0
-        For k = 1 To ListsRange.Count
-            If ListsRange(k, Ofs_InPriceList) <> 1 Then
-                GoTo End_of_For_1
-            End If
-            
-            If ListsRange(k, Ofs_ChkAlias) = 1 Then
-                Set DstRange = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3)
-                RestoreAliasZonePrice DstRange, idx_PriceIN + i
-            End If
-            
-            i = i + 1
-End_of_For_1:
-        Next k
-        .Application.ScreenUpdating = True
-    End With
-
-End Sub
-
-Sub RestoreAliasZonePrice(r As Range, PriceIndex As Integer)
-    Dim Src As Range
-    Dim Dst As Range
-    Dim IdxAliasPrice As Integer
-    Dim AreaCount As Integer
-    
-    Set Dst = r
-    
-    AreaCount = GetLinesCount(Dst)
-    
-    Set Dst = r
-    While Dst <> ""
-        If Dst.Offset(0, PriceIndex) = "-" Then
-            IdxAliasPrice = 1
-            Do
-                IdxAliasPrice = GetAliasDescrIdx(Dst.Offset(0, idx_eDescr), AreaCount, IdxAliasPrice)
-                If IdxAliasPrice = -1 Then
-                    Exit Do
-                End If
-                Set Src = r.Offset(IdxAliasPrice - 3, 0)
-                If Application.WorksheetFunction.IsNumber(Src.Offset(0, PriceIndex)) Then
-                    Exit Do
-                Else
-                    IdxAliasPrice = IdxAliasPrice + 1
-                End If
-            Loop
-            
-            If IdxAliasPrice > -1 Then
-                Set Src = r.Offset(IdxAliasPrice - 3, PriceIndex)
-                If Application.WorksheetFunction.IsNumber(Src) Then
-                    Dst.Offset(0, PriceIndex) = Src
-                    With Dst.Offset(0, PriceIndex)
-                        .Font.Bold = True
-                        .Font.Underline = xlUnderlineStyleSingle
-                        .Font.Italic = False
-                        .Font.ColorIndex = 10 ' green
-                    End With
-                End If
-            End If
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-Sub RestoreChildZonePrice(r As Range, PriceIndex As Integer)
-    Dim Dst As Range
-    Dim IdxParentPrice As Integer
-    Dim AreaCount As Integer
-    
-    Set Dst = r
-    
-    AreaCount = GetLinesCount(Dst)
-    
-    Set Dst = r
-    While Dst <> ""
-        If Dst.Offset(0, PriceIndex) = "-" Then
-            IdxParentPrice = FindGlobalAreaIdx(Dst, AreaCount)
-            If IdxParentPrice > -1 Then
-                Dst.Offset(0, PriceIndex) = r.Offset(IdxParentPrice - 3, PriceIndex)
-                With Dst.Offset(0, PriceIndex)
-                    .Font.Bold = False
-                    .Font.Italic = True
-                    .Font.ColorIndex = 29 ' magenta
-                End With
-            End If
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-Sub RestoreParentZonePrice(r As Range, PriceIndex As Integer)
-    Dim Src As Range
-    Dim Dst As Range
-    Dim IdxMaxPrice As Integer
-    
-    Set Dst = r
-    
-    While Dst <> ""
-        If Dst.Offset(0, PriceIndex) = "-" Then
-            Set Src = Dst.Offset(1, 0)
-            IdxMaxPrice = GetZoneMaxPrice(Dst, Src, PriceIndex)
-            If IdxMaxPrice >= 0 Then
-                Dst.Offset(0, PriceIndex) = Src.Offset(IdxMaxPrice, PriceIndex)
-                With Dst.Offset(0, PriceIndex)
-                    .Font.Bold = True
-                    .Font.Italic = True
-                    .Font.ColorIndex = 3 ' Red
-                End With
-            End If
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-Function GetZoneMaxPrice(Dst As Range, Src As Range, price_idx As Integer) As Integer
-    Dim s As String
-    Dim MaxPrice As Double
-    Dim MaxPriceIdx As Integer
-    
-    GetZoneMaxPrice = -1
-    MaxPrice = -1
-    MaxPriceIdx = 0
-    
-    While InStr(1, Src.Offset(MaxPriceIdx, 0), Dst) > 0
-        
-        If Application.WorksheetFunction.IsNumber(Src.Offset(MaxPriceIdx, price_idx)) Then
-            If MaxPrice < Src.Offset(MaxPriceIdx, price_idx) Then
-                MaxPrice = Src.Offset(MaxPriceIdx, price_idx)
-                GetZoneMaxPrice = MaxPriceIdx
-            End If
-        End If
-        MaxPriceIdx = MaxPriceIdx + 1
-    Wend
-End Function
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-mOpPrices
->>>>>>
-Attribute VB_Name = "mOpPrices"
-Option Explicit
-
-Public Const idx_PriceIN As Integer = 4
-
-Sub Step_3_Recalc_1st_Prices()
-    AnalyzeOpPricesData WKS_PRICE_NAME, "0.0000"
-End Sub
-
-
-
-Sub AnalyzeOpPricesData(wks_name As String, DATA_fmt As String)
-
-' ��������� ������ ��� �� ������� �����
-' ������� ���������� ������
-    ClearWorkArea (wks_name)
-    
-    ThisWorkbook.Worksheets(wks_name).Activate
-    ThisWorkbook.Worksheets(wks_name).Cells.Select
-    With Selection
-        .ClearContents
-        .Interior.ColorIndex = xlNone
-        .Font.Bold = False
-        .Font.ColorIndex = 0
-        .HorizontalAlignment = xlGeneral
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .ShrinkToFit = False
-        .MergeCells = False
-    End With
-    ThisWorkbook.Worksheets(wks_name).Range("A1").Select
-
-' ������������ ���������� �������� � �����-������
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim j As Integer
-    Dim k As Integer
-    Dim ListsRange_PriceCount As Integer
-    
-    Set ListsRange = ThisWorkbook.Worksheets(WKS_HOME_NAME).Range("OpList")
-    ListsRange_PriceCount = 0
-
-    For i = 1 To ListsRange.Count
-        If ListsRange(i, Ofs_InPriceList) = 1 Then
-            ListsRange_PriceCount = ListsRange_PriceCount + 1
-        End If
-    Next i
-
-
-
-' ����������� ��������� �������� �����
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-
-
-        With DstRange
-            .Offset(-2, idx_sCode) = "Common"
-            .Offset(-1, idx_sCode) = "sCode"
-            .Offset(-1, idx_Code) = "Code"
-            .Offset(-1, idx_eDescr) = "Descr_E"
-            .Offset(-1, idx_rDescr) = "Descr_R"
-            .Offset(-2, idx_PriceIN) = "Price (In)"
-            k = 1
-            For i = 1 To ListsRange.Count
-                If ListsRange(i, Ofs_InPriceList) = 1 Then
-                    .Offset(-1, k + idx_PriceIN - 1) = ListsRange(i, 1)
-                    k = k + 1
-                End If
-            Next i
-            .Offset(-2, idx_PriceIN + ListsRange_PriceCount) = "Stat of Price (IN)"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount) = "Count"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 1) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 1) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 2) = "Max"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 3) = "Avg"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 4) = "Down"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 5) = "Up"
-            .Offset(-2, idx_PriceIN + ListsRange_PriceCount + 6) = "Operators"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 6) = "Price"
-            .Offset(-2, idx_PriceIN + ListsRange_PriceCount + 7) = "Profit[x100%]"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 7) = "Avg"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 8) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 9) = "Max"
-            .Offset(-2, idx_PriceIN + ListsRange_PriceCount + 10) = "Op Profit[x100%] (Routing type 1)"
-            j = idx_PriceIN + ListsRange_PriceCount + 10
-            k = 1
-            For i = 1 To ListsRange.Count
-                If ListsRange(i, Ofs_InPriceList) = 1 Then
-                    .Offset(-1, k + j - 1) = ListsRange(i, 1)
-                    k = k + 1
-                End If
-            Next i
-            With .Offset(-2, 0).EntireRow
-                .HorizontalAlignment = xlLeft
-                .Font.Bold = True
-            End With
-            With .Offset(-1, 0).EntireRow
-                .HorizontalAlignment = xlCenter
-                .Font.Bold = True
-            End With
-            
-        End With
-
-' �������� ��������� ������ �� ������� ����
-        Set SrcRange = .Worksheets(WKS_FIX_AREAS_NAME).Range(WKS_A3)
-        
-        CopyAreasList DstRange, SrcRange
-        
-        Set SrcRange = .Worksheets(WKS_AREAS_NAME).Range(WKS_A3)
-        
-        Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-    End With
-
-' ������������ ����� ���������� ���
-
-    Dim AreaCount As Integer
-    AreaCount = GetLinesCount(DstRange)
-
-
-' ����������� ���������� ���������
-        
-    For i = 1 To 4
-        Set DstRange = ThisWorkbook.Worksheets(wks_name) _
-                    .Range(Cells(2, i), Cells(2 + AreaCount, i))
-        With DstRange
-            .EntireColumn.AutoFit
-            If i Mod 2 = 1 Then
-                .Interior.ColorIndex = 36 ' LightYellow
-            Else
-                .Interior.ColorIndex = xlNone  'White
-            End If
-        End With
-    Next i
-
-' ���������� ����/������ ���� ���������� � ��������� ����� ������ ��� �� �����
-' �������� ���� ���������� ��� ���
-
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        i = 1
-        For k = 1 To ListsRange.Count
-            If ListsRange(k, Ofs_InPriceList) <> 1 Then
-                GoTo End_of_For_1
-            End If
-            Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-            s = ListsRange.Cells(k, 1).Value
-            If wks_name = WKS_TRAFFIC_NAME Then
-                s = s & ".Data"
-            End If
-            
-            If SheetExist(s) Then
-                Set SrcRange = .Worksheets(s).Range(WKS_A3)
-    
-                AddOpPriceData DstRange, SrcRange, i - 1
-                
-            End If
-            
-' ����������� ���������� ���������
-            With .Worksheets(wks_name)
-                Set DstRange = .Range(.Cells(2, idx_Price + i), .Cells(2 + AreaCount, idx_Price + i))
-            End With
-            With DstRange
-                .NumberFormat = DATA_fmt
-                .Font.Bold = True
-                .HorizontalAlignment = xlCenter
-                .VerticalAlignment = xlBottom
-                .WrapText = False
-                .Orientation = 0
-                .AddIndent = False
-                .ShrinkToFit = False
-                .MergeCells = False
-                If i Mod 2 = 1 Then
-                    .Interior.ColorIndex = 36 ' LightYellow
-                Else
-                    .Interior.ColorIndex = xlNone  'White
-                End If
-            End With
-            i = i + 1
-End_of_For_1:
-        Next k
-        
-' ��������� ������ ����������� � ������� ���������
-
-        With Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, idx_Price + 1), .Cells(2 + AreaCount, idx_Price + ListsRange_PriceCount))
-        End With
-        
-'        DstRange.Select
-        
-        For Each SrcRange In DstRange
-            If SrcRange = "" Then
-                SrcRange = "-"
-            End If
-        Next SrcRange
-        
-        Set SrcRange = .Worksheets(wks_name).Range(WKS_A3)
-    End With
-    
-' ������������ ���������� �� �����
-    Set DstRange = ThisWorkbook.Worksheets(wks_name) _
-                .Range(WKS_A3).Offset(0, idx_PriceIN + ListsRange_PriceCount)
-                
-    DstRange.Select
-    
-    Dim Stat1stCol As Integer
-    Dim StatMinCol As Integer
-    Dim StatMaxCol As Integer
-    Dim StatAvgCol As Integer
-    Dim StatDnCol As Integer
-    Dim StatUpCol As Integer
-    
-    Dim offsetMinCol As Integer
-    Dim offsetMaxCol As Integer
-    Dim offsetAvgCol As Integer
-    Dim offsetUpCol As Integer
-    Dim offsetDnCol As Integer
-    Dim offsetPriceCol As Integer
-    Dim offsetAvgPtCol As Integer
-    Dim offsetMinPtCol As Integer
-    Dim offsetMaxPtCol As Integer
-    
-    
-    Stat1stCol = idx_PriceIN + ListsRange_PriceCount + 1
-    
-    offsetMinCol = 1
-    offsetMaxCol = 2
-    offsetAvgCol = 3
-    offsetUpCol = 4
-    offsetDnCol = 5
-    offsetPriceCol = 6
-    offsetAvgPtCol = 7
-    offsetMinPtCol = 8
-    offsetMaxPtCol = 9
-    
-    StatMinCol = Stat1stCol + offsetMinCol
-    StatMaxCol = Stat1stCol + offsetMaxCol
-    StatAvgCol = Stat1stCol + offsetAvgCol
-    StatUpCol = Stat1stCol + offsetUpCol
-    StatDnCol = Stat1stCol + offsetDnCol
-    
-    
-    For i = 0 To AreaCount - 1
-        s = RC2ADDR(i + 3, idx_PriceIN + 1) & ":" & RC2ADDR(i + 3, idx_PriceIN + ListsRange_PriceCount)
-        DstRange.Offset(i, 0).Formula = "=count(" & s & ")"
-        
-        Dim AnchorCell As String
-        AnchorCell = RC2ADDR(i + 3, Stat1stCol)
-        
-        DstRange.Offset(i, offsetMinCol).Formula = "=if(" & AnchorCell & ">0, min(" & s & "), ""-"")"
-        DstRange.Offset(i, offsetMaxCol).Formula = "=if(" & AnchorCell & ">0, max(" & s & "), ""-"")"
-        DstRange.Offset(i, offsetAvgCol).Formula = "=if(" & AnchorCell & ">0, average(" & s & "), ""-"")"
-        s = "=if(" & AnchorCell & ">0,(" & RC2ADDR(i + 3, StatAvgCol) & "-" & RC2ADDR(i + 3, StatMaxCol) & ")/" & RC2ADDR(i + 3, StatAvgCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetDnCol)
-            .Formula = s
-            .NumberFormat = "0.00%_);[Red](0.00)%"
-        End With
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, StatAvgCol) & "-" & RC2ADDR(i + 3, StatMinCol) & ")/" & RC2ADDR(i + 3, StatAvgCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetUpCol)
-            .Formula = s
-            .NumberFormat = "0.00%"
-        End With
-
-' ������ ��������� ���� �� �������.
-        s = "=if(" & AnchorCell & ">0, if(" & RC2ADDR(i + 3, StatAvgCol) & "<=Trigger, " & RC2ADDR(i + 3, StatAvgCol) & "+FixedV," & RC2ADDR(i + 3, StatAvgCol) & "* FIxedP), ""-"")"
-        With DstRange.Offset(i, offsetPriceCol)
-            .Formula = s
-            .NumberFormat = "0.000"
-        End With
-
-' ������ ������� � �������.
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & RC2ADDR(i + 3, StatAvgCol) & ")/" & RC2ADDR(i + 3, StatAvgCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetAvgPtCol)
-            .Formula = s
-            .HorizontalAlignment = xlCenter
-            .NumberFormat = "0.00%_);[Red](0.00)%"
-        End With
-
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & RC2ADDR(i + 3, StatMaxCol) & ")/" & RC2ADDR(i + 3, StatMaxCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetMinPtCol)
-            .Formula = s
-            .HorizontalAlignment = xlCenter
-            .NumberFormat = "0.00%_);[Red](0.00)%"
-        End With
-
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & RC2ADDR(i + 3, StatMinCol) & ")/" & RC2ADDR(i + 3, StatMinCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetMaxPtCol)
-            .Formula = s
-            .HorizontalAlignment = xlCenter
-            .NumberFormat = "0.00%_);[Red](0.00%)"
-        End With
-
-' ������ ������� � ������� �� ���������� (Routing type 1)
-        
-        j = 1
-        For k = 1 To ListsRange.Count
-            If ListsRange(k, Ofs_InPriceList) = 1 Then
-                AnchorCell = RC2ADDR(i + 3, idx_PriceIN + j)
-                s = "=if(isnumber(" & AnchorCell & "), (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & AnchorCell & ")/" & AnchorCell & ", ""-"")"
-                With DstRange.Offset(i, offsetMaxPtCol + j)
-                    .Formula = s
-                    .NumberFormat = "0.00%_);[Red](0.00)%"
-                End With
-                j = j + 1
-            End If
-        Next k
-    Next i
-
-
-' ����������� ���������� ���������
-' ����������
-    For i = 0 To 5
-        With ThisWorkbook.Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, Stat1stCol + i), .Cells(2 + AreaCount, Stat1stCol + i))
-        End With
-        With DstRange
-            If i > 0 And i <= 3 Then
-                .NumberFormat = DATA_fmt
-            End If
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-            .WrapText = False
-            .Orientation = 0
-            .AddIndent = False
-            .ShrinkToFit = False
-            .MergeCells = False
-            If i Mod 2 = 0 Then
-                .Interior.ColorIndex = 35 ' LightLightGreen
-            Else
-                .Interior.ColorIndex = 34  ' LightLightBlue
-            End If
-        End With
-    Next i
-
-' ������ ������� "Operators price"
-
-    With ThisWorkbook.Worksheets(wks_name)
-        Set DstRange = .Range(.Cells(1, Stat1stCol + offsetPriceCol), .Cells(2 + AreaCount, Stat1stCol + offsetPriceCol))
-        With DstRange
-            .Interior.ColorIndex = 36 ' LightYellow
-            .Font.ColorIndex = 10
-            .Font.Bold = True
-            .NumberFormat = "0.0000"
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-        End With
-    End With
-
-' ������ ������� � ������� �� ���������� (Routing type 1)
-    For j = 1 To ListsRange_PriceCount
-        With ThisWorkbook.Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, Stat1stCol + offsetMaxPtCol + j), .Cells(2 + AreaCount, Stat1stCol + offsetMaxPtCol + j))
-        End With
-        With DstRange
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-            .WrapText = False
-            .Orientation = 0
-            .AddIndent = False
-            .ShrinkToFit = False
-            .MergeCells = False
-            If j Mod 2 = 0 Then
-                .Interior.ColorIndex = 34  ' LightLightBlue
-            Else
-                .Interior.ColorIndex = 35 ' LightLightGreen
-            End If
-        End With
-    Next j
-    Application.ScreenUpdating = True
-End Sub
-
-Sub CopyAreasList(Dst As Range, Src As Range)
-    While Src <> ""
-        Dst.Offset(0, idx_sCode).Value = Src.Offset(0, idx_sCode).Value
-        Dst.Offset(0, idx_Code).Value = Src.Offset(0, idx_Code).Value
-        Dst.Offset(0, idx_eDescr).Value = Src.Offset(0, idx_eDescr).Value
-        Dst.Offset(0, idx_rDescr).Value = Src.Offset(0, idx_rDescr).Value
-        Set Src = Src.Offset(1, 0)
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-
-Sub AddOpPriceData(Dst As Range, Src As Range, index As Integer)
-    While Src <> "" And Dst <> ""
-        If Dst = Src Then
-            Dst.Offset(0, idx_Price + index) = Src.Offset(0, idx_Price)
-            Set Dst = Dst.Offset(1, 0)
-        End If
-        If Dst > Src Then
-            Set Src = Src.Offset(1, 0)
-        End If
-        If Dst < Src Then
-            Set Dst = Dst.Offset(1, 0)
-        End If
-    Wend
-End Sub
-
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet27
->>>>>>
-Attribute VB_Name = "Sheet27"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-mGlobalList
->>>>>>
-Attribute VB_Name = "mGlobalList"
-Option Explicit
-
-
-
-
-Sub Step_1_BuildWorkPriceLists()
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            CreateComSheet (s)
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            Set SrcRange = .Worksheets(s & ".Tarif").Range(WKS_A3)
-            
-            MarkDublicates SrcRange
-            
-            Set SrcRange = .Worksheets(s & ".Tarif").Range(WKS_A3)
-            AddOpArea DstRange, SrcRange, ADD_CODE_PRICE
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            
-            If SheetExist(s & ".Data") Then
-                Set SrcRange = .Worksheets(s & ".Data").Range(WKS_A3)
-                AddOpArea DstRange, SrcRange, ADD_CODE_TRAFFIC
-            End If
-            
-' ����������� ����� ������:
-' 00 - �� ���������, �� ������������
-' 01 - �� ���������, ������������
-' 10 - ���������, �� ������������
-' 11 - ���������, ������������
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            While DstRange <> ""
-                If DstRange.Offset(0, idx_Price) = 0 Or DstRange.Offset(0, idx_Price) = "-" Then
-                    If DstRange.Offset(0, idx_Traffic) = 0 Then
-                        DstRange.Offset(0, idx_Status) = 0
-                    Else
-                        DstRange.Offset(0, idx_Status) = 1
-                    End If
-                Else
-                    If DstRange.Offset(0, idx_Traffic) = 0 Then
-                        DstRange.Offset(0, idx_Status) = 10
-                    Else
-                        DstRange.Offset(0, idx_Status) = 11
-                    End If
-                End If
-                Set DstRange = DstRange.Offset(1, 0)
-            Wend
-                
-            With .Worksheets(s)
-                With .Columns("A:H")
-                    .HorizontalAlignment = xlHAlignGeneral
-                    .VerticalAlignment = xlBottom
-                    .WrapText = False
-                    .Orientation = 0
-                    .AddIndent = False
-                    .ShrinkToFit = True
-                    .MergeCells = False
-                End With
-                .Columns("A:A").HorizontalAlignment = xlLeft
-                .Columns("B:B").NumberFormat = "#"
-                With .Rows("2:2")
-                    .Font.Bold = False
-                    .WrapText = False
-                    .HorizontalAlignment = xlCenter
-                End With
-                With .Columns("G:G")
-                    .HorizontalAlignment = xlHAlignCenter
-                    .NumberFormat = "0#"
-                End With
-            End With
-            MarkDublicates (.Worksheets(s).Range(WKS_A3))
-        Next i
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-        
-    End With
-
-End Sub
-
-Sub Step_2_CreateGlobalCodeList()
-
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-' ������� ���������� ������
-    ClearWorkArea WKS_AREAS_NAME, "A1"
-    
-' ��������� ����� ������ ���
-
-    
-    BuildAreasList (WKS_AREAS_NAME)
-    
-    BuildAreasStatus (WKS_AREAS_NAME)
-
-    
-End Sub
-
-Sub BuildAreasList(DstName As String)
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-        
-' ��������� ������ ���������
-        With .Worksheets(DstName)
-            .Range("a1") = DstName
-            With .Range("a2")
-                .Offset(0, idx_sCode) = "sCode"
-                .Offset(0, idx_Code) = "Code"
-                .Offset(0, idx_eDescr) = "Descr_E"
-                .Offset(0, idx_rDescr) = "Descr_R"
-            End With
-            With .Rows("2:2")
-                .Font.Bold = False
-                .WrapText = False
-                .HorizontalAlignment = xlCenter
-            End With
-        End With
-        
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            If SheetExist(s) Then
-                Set DstRange = .Worksheets(WKS_AREAS_NAME).Range(WKS_A3)
-                Set SrcRange = .Worksheets(s).Range(WKS_A3)
-        
-                AddGlobalOpArea DstRange, SrcRange
-            End If
-        Next i
-        Set SrcRange = .Worksheets(DstName).Range(WKS_A3)
-        .Worksheets(DstName).Select
-                
-        MarkDublicates (.Worksheets(DstName).Range(WKS_A3))
-        
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-    End With
-End Sub
-
-Sub AddGlobalOpArea(Dst As Range, Src As Range)
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst.Offset(0, idx_sCode) = Src.Offset(0, idx_sCode)
-            Dst.Offset(0, idx_Code) = Src.Offset(0, idx_Code)
-        End If
-        If Dst = Src Then
-            CheckNameOpArea Dst, Src, ADD_CODE_ONLY
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    
-    Dst.Worksheet.Columns("A:H").AutoFit
-    
-    Set Dst = Dst.Worksheet.Range(WKS_A3)
-    
-End Sub
-
-Sub CheckNameOpArea(Dst As Range, Src As Range, ByVal add_type As Integer)
-    
-    Dim Exist_SrcEng As Boolean
-    Dim Exist_SrcRus As Boolean
-    Dim Exist_DstEng As Boolean
-    Dim Exist_DstRus As Boolean
-    
-    Dim Unknown_Src As Boolean
-    Dim Unknown_Dst As Boolean
-    
-    With Dst
-        Exist_DstEng = .Offset(0, idx_eDescr) <> "" And .Offset(0, idx_eDescr) <> UNKNOWN_AREA And .Offset(0, idx_eDescr) <> NONAME_AREA
-        Exist_DstRus = .Offset(0, idx_rDescr) <> "" And .Offset(0, idx_rDescr) <> UNKNOWN_AREA And .Offset(0, idx_rDescr) <> NONAME_AREA
-    End With
-    
-    Unknown_Dst = Not (Exist_DstEng Or Exist_DstRus)
-    
-    If add_type = ADD_CODE_TRAFFIC Then
-        If Unknown_Dst Then
-            Dst.Offset(0, idx_eDescr) = UNKNOWN_AREA & Dst.Offset(0, idx_Code)
-            Dst.Offset(0, idx_rDescr) = UNKNOWN_AREA & Dst.Offset(0, idx_Code)
-        End If
-        Exit Sub
-    End If
-    
-    With Src
-        Exist_SrcEng = .Offset(0, idx_eDescr) <> "" And .Offset(0, idx_eDescr) <> UNKNOWN_AREA And .Offset(0, idx_eDescr) <> NONAME_AREA
-        Exist_SrcRus = .Offset(0, idx_rDescr) <> "" And .Offset(0, idx_rDescr) <> UNKNOWN_AREA And .Offset(0, idx_rDescr) <> NONAME_AREA
-    End With
-    
-    Unknown_Src = Not (Exist_SrcEng Or Exist_SrcRus)
-    
-    If Unknown_Src And Unknown_Dst Then
-        Dst.Offset(0, idx_eDescr) = UNKNOWN_AREA
-        Dst.Offset(0, idx_rDescr) = UNKNOWN_AREA
-        Exit Sub
-    End If
-    
-    If Unknown_Src Then
-        If Not Exist_DstRus Then
-            Dst.Offset(0, idx_rDescr) = NONAME_AREA
-        End If
-        If Not Exist_DstEng Then
-            Dst.Offset(0, idx_eDescr) = NONAME_AREA
-        End If
-    Else
-        If Not Exist_DstEng Then
-            If Exist_SrcEng Then
-                Dst.Offset(0, idx_eDescr) = Src.Offset(0, idx_eDescr)
-            Else
-                Dst.Offset(0, idx_eDescr) = NONAME_AREA
-            End If
-        End If
-        If Not Exist_DstRus Then
-            If Exist_SrcRus Then
-                Dst.Offset(0, idx_rDescr) = Src.Offset(0, idx_rDescr)
-            Else
-                Dst.Offset(0, idx_rDescr) = NONAME_AREA
-            End If
-        End If
-    End If
-End Sub
-
-Sub AddOpArea(Dst As Range, Src As Range, Optional add_type = ADD_CODE_ONLY)
-    
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst.Offset(0, idx_sCode) = Src.Offset(0, idx_sCode)
-            Dst.Offset(0, idx_Code) = Src.Offset(0, idx_Code)
-        End If
-        If Dst = Src Then
-            Select Case add_type
-                Case ADD_CODE_PRICE
-                    Dst.Offset(0, idx_Price) = Src.Offset(0, idx_Price)
-                    If Dst.Offset(0, idx_Price) = "" Then
-                        Dst.Offset(0, idx_Price) = "-"
-                    End If
-                Case ADD_CODE_TRAFFIC
-                    Dst.Offset(0, idx_Traffic) = Src.Offset(0, idx_DatTraffic)
-                    Dst.Offset(0, idx_Calls) = Src.Offset(0, idx_DatCalls)
-                    
-            End Select
-            
-            CheckNameOpArea Dst, Src, add_type
-                        
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    
-    Select Case add_type
-        Case ADD_CODE_PRICE
-            Dst.Worksheet.Columns("E:E").NumberFormat = "0.0000"
-        Case ADD_CODE_TRAFFIC
-            Dst.Worksheet.Columns("F:F").NumberFormat = "0.00"
-    End Select
-    
-    Dst.Worksheet.Columns("A:H").AutoFit
-    
-    Set Dst = Dst.Worksheet.Range("A1")
-End Sub
-
-Sub BuildAreasStatus(wks_name As String)
-    Dim rSrc As Range
-    Dim rDst As Range
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim j As Integer
-    Dim s As String
-    Dim WS_Name As String
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        
-' ��������� ������ ������
-
-        Dim AreaCount As Integer
-
-        Set rDst = .Worksheets(wks_name).Range(WKS_A3)
-        
-        AreaCount = GetLinesCount(rDst) + 3
-
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        Set rDst = .Worksheets(wks_name).Range(WKS_A3)
-        j = 3
-        
-        For i = 1 To ListsRange.Count
-            rDst.Offset(-1, i + idx_GLStatus).Formula = ListsRange(i, 1)
-        Next i
-        
-' ��������� ������� ��� ��� ������ ����������
-        While rDst <> ""
-            For i = 1 To ListsRange.Count
-                WS_Name = ListsRange(i, 1)
-                If SheetExist(WS_Name) Then
-                    s = "INDEX(" & WS_Name & "!G1:$G$" & AreaCount & ", MATCH($A" & j & "," & WS_Name & "!$A$1:$A$" & AreaCount & ",0), 1)"
-                    s = "=if(iserror(" & s & "), ""-""," & s & ")"
-                Else
-                    s = "-"
-                End If
-                rDst.Offset(0, i + idx_GLStatus).Formula = s
-                rDst.Offset(0, i + idx_GLStatus).NumberFormat = "0#"
-            Next i
-            j = j + 1
-            Set rDst = rDst.Offset(1, 0)
-        Wend
-        
-' ����������� ���������
-        For i = 0 To ListsRange.Count
-            With rDst.Offset(-1, i + idx_GLStatus).EntireColumn
-                .HorizontalAlignment = xlCenter
-                .ShrinkToFit = True
-            End With
-        Next i
-
-' ������������ �������� ���
-
-        With .Worksheets(wks_name)
-            Set rDst = .Range(.Cells(3, 1), .Cells(AreaCount, 1))
-        End With
-
-        Set rSrc = .Worksheets(WKS_FIX_AREAS_NAME).Range(WKS_A3)
-        
-        AreaCount = GetLinesCount(rSrc) + 3
-
-        With .Worksheets(WKS_FIX_AREAS_NAME)
-            Set rSrc = .Range(.Cells(2, 1), .Cells(AreaCount, 1))
-        End With
-
-        Dim b As Range
-        Dim c As Range
-        For Each c In rDst
-            Set b = rSrc.Find(c, LookIn:=xlValues, MatchByte:=True)
-            If Not b Is Nothing Then
-                If c.Offset(0, idx_eDescr) <> b.Offset(0, idx_eDescr) Or c.Offset(0, idx_rDescr) <> b.Offset(0, idx_rDescr) Then
-                    c.Offset(0, idx_eDescr) = b.Offset(0, idx_eDescr)
-                    c.Offset(0, idx_rDescr) = b.Offset(0, idx_rDescr)
-                    c.Offset(0, idx_GLStatus) = "Fixed"
-                    With c.EntireRow
-                        .Font.Bold = True
-                        .Font.ColorIndex = xlColorIndexAutomatic
-                    End With
-                Else
-                    c.Offset(0, idx_GLStatus) = "-"
-                End If
-            Else
-                If c.Offset(0, idx_sCode) <> "" Then
-                    Dim FixedList As Range
-                    c.Offset(0, idx_GLStatus) = "New"
-                    With c.EntireRow
-                        .Font.Bold = True
-                        .Font.ColorIndex = 3 ' Red
-                    End With
-                End If
-                
-'                Set Fixed
-            End If
-        Next c
-        
-        Application.ScreenUpdating = True
-        
-    End With
-End Sub
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Sub ClearWorkArea(DstName As String, Optional StartRange As String = WKS_A3)
-    Dim DstRange As Range
-    With ThisWorkbook
-       
-        Set DstRange = .Worksheets(DstName).Range(StartRange)
-        Worksheets(DstName).Select
-        DstRange.Select
-        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
-        Range(Selection, Selection.End(xlDown)).Select
-        Selection.Delete Shift:=xlUp
-        Selection.Font.Bold = False
-        Selection.Font.ColorIndex = xlColorIndexAutomatic
-        Set DstRange = .Worksheets(DstName).Range(StartRange)
-        DstRange.Select
-    End With
-End Sub
-
-Function SheetExist(SheetName As String) As Boolean
-    Dim Count, i As Integer
-
-    Count = ThisWorkbook.Sheets.Count
-    SheetExist = False
-    For i = 1 To Count
-        If ThisWorkbook.Sheets(i).Name = SheetName Then
-            SheetExist = True
-            i = Count
-        End If
-    Next i
-End Function
-
-Function GetLinesCount(r As Range) As Integer
-
-    Dim LinesCount As Integer
-    Dim rr As Range
-    
-    Set rr = r
-    
-    LinesCount = 0
-
-    While rr <> ""
-        LinesCount = LinesCount + 1
-        Set rr = rr.Offset(1, 0)
-    Wend
-    
-    GetLinesCount = LinesCount
-End Function
-
-Sub CreateComSheet(wks_name As String)
-    Dim theRange As Range
-    With ThisWorkbook
-        If Not SheetExist(wks_name) Then
-            .Sheets.Add.Name = wks_name
-        End If
-            
-        .Sheets(wks_name).Visible = True
-        .Sheets(wks_name).Select
-        Cells.Select
-        Selection.ClearContents
-        Selection.Interior.ColorIndex = xlNone
-        Selection.Borders(xlLeft).LineStyle = xlNone
-        Selection.Borders(xlRight).LineStyle = xlNone
-        Selection.Borders(xlTop).LineStyle = xlNone
-        Selection.Borders(xlBottom).LineStyle = xlNone
-        Selection.BorderAround LineStyle:=xlNone
-        Selection.Font.ColorIndex = 0
-        Selection.EntireColumn.ColumnWidth = ActiveSheet.StandardWidth
-    
-        With .Worksheets(wks_name)
-            .Range("a1") = wks_name
-            With .Range("a2")
-                .Offset(0, idx_sCode) = "sCode"
-                .Offset(0, idx_Code) = "Code"
-                .Offset(0, idx_eDescr) = "Descr_E"
-                .Offset(0, idx_rDescr) = "Descr_R"
-                .Offset(0, idx_Price) = "Price"
-                .Offset(0, idx_Traffic) = "Traffic"
-                .Offset(0, idx_Calls) = "Calls"
-                .Offset(0, idx_Status) = "Status"
-            End With
-            With .Rows("2:2")
-                .Font.Bold = False
-                .WrapText = False
-                .HorizontalAlignment = xlCenter
-            End With
-            .Range("A1").Select
-        End With
-    End With
-End Sub
-
-' ���������� index ����� ���� �������� �� �������������� ������ ���� ���, ������� �� StartIndex
-' ������ ��� ���� Russia, Moscow ���������� ����� �������� ���� � ������ Russia
-' ���������� �������:
-' -1 ����������� ���� ��� �������� ����������
-' > 0 - ���������� ���� ��������� ���������� ���� � ������
-
-Function GetAliasDescrIdx(Dst As Range, AreaCount As Integer, Optional StartIndex As Integer = 1) As Integer
-    Dim s As String
-    Dim idx As Integer
-    
-    s = Dst
-    idx = StartIndex
-    
-    GetAliasDescrIdx = -1
-    
-    With Dst.Worksheet
-        Do
-            idx = FindVIndex(Dst.EntireColumn, AreaCount, s, idx)
-            If idx > 0 Then
-                If idx <> Dst.Row Then
-                    GetAliasDescrIdx = idx
-                    Exit Do
-                Else
-                    idx = idx + 1
-                End If
-            End If
-        Loop While (idx <> -1)
-    End With
-End Function
-
-' ���������� index ����������� ����� ���� �� �������������� ������ ���� ���
-' ������ ��� ���� Russia, Moscow ���������� ����� �������� ���� � ������ Russia
-' ���������� �������:
-' -1 ����������� ���� ��� �������� ����������
-' > 0 - ���������� ���� ��������� ���������� ���� � ������
-
-Function GetGlobalDescrIdx(Dst As Range, AreaCount As Integer, Optional StartIndex As Integer = 1) As Integer
-    Dim iStrPos As Integer
-    Dim s As String
-    Dim idx As Integer
-    
-    s = Dst
-    idx = StartIndex
-    iStrPos = Len(s)
-    
-    GetGlobalDescrIdx = -1
-    
-    With Dst.Worksheet
-        Do
-            idx = FindVIndex(Dst.EntireColumn, AreaCount, s, idx)
-            If idx > 0 Then
-                If idx <> Dst.Row Then
-                    GetGlobalDescrIdx = idx
-                    Exit Do
-                Else
-                    idx = idx + 1
-                End If
-            Else
-                iStrPos = InStrRev(s, " ") - 1
-                If iStrPos = -1 Then
-                    iStrPos = InStrRev(s, ",") - 1
-                End If
-                If iStrPos <> -1 Then
-                    idx = 1
-                    s = Left(s, iStrPos)
-                End If
-            End If
-        Loop While (idx <> -1 And iStrPos <> 0)
-    End With
-End Function
-
-' ���������� index ���������� ���� �� �������������� ������ ���
-' ������ ��� ���� s709643 ���������� ����� �������� ���� s7096 � s7
-
-' ���������� �������:
-' -1 ����������� ���� �������� ����������
-' > 0 - ������ � ������ ���������� ����
-
-Function FindGlobalAreaIdx(Dst As Range, AreaCount As Integer) As Integer
-    Dim iStrPos As Integer
-    Dim s As String
-    Dim idx As Integer
-    
-    FindGlobalAreaIdx = -1
-    
-    s = Dst
-    If s = "" Then
-        Exit Function
-    End If
-    
-    idx = 1
-    iStrPos = Len(s) - 1
-    
-    With Dst.Worksheet
-        s = Left(s, iStrPos)
-        Do
-            idx = FindVIndex(Dst.EntireColumn, AreaCount, s, idx)
-            If idx > 0 Then
-                If idx <> Dst.Row Then
-                    FindGlobalAreaIdx = idx
-                    Exit Do
-                Else
-                    idx = idx + 1
-                End If
-            Else
-                iStrPos = iStrPos - 1
-                If iStrPos > 1 Then
-                    s = Left(s, iStrPos)
-                    idx = 1
-                End If
-            End If
-        Loop While (idx <> -1 And iStrPos <> 0)
-    End With
-End Function
-
-' ���������� index ���������� ���� �� �������������� ������ ���
-' ������ ��� ���� 709643 ���������� ����� �������� ���� 7096 � 7
-
-' ���������� �������:
-' -1 ����������� ���� �������� ����������
-' > 0 - ������ � ������ ���������� ����
-
-Function GetGlobalAreaIdx(wks_name As String, range_name As String, AreaCount As Integer, scDst) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim Answer As Integer
-    
-    GetGlobalAreaIdx = -1
-    
-    With ThisWorkbook.Worksheets(wks_name)
-        For i = Len(scDst) To 2 Step -1
-            s = Left(scDst, i)
-            Answer = FindVIndex(.Range(range_name), AreaCount, s)
-            If Answer > 0 Then
-                GetGlobalAreaIdx = Answer
-                Exit Function
-            End If
-        Next i
-    End With
-End Function
-
-Function FindVIndex(Src As Range, AreaCount As Integer, s As String, Optional Start As Integer = 1) As Integer
-    Dim l As Long
-    FindVIndex = -1
-    For l = Start To AreaCount
-        If s = Src.Cells(l, 1) Then
-            FindVIndex = l
-            Exit Function
-        End If
-    Next l
-End Function
-
-Sub MarkDublicates(Src As Range)
-    Dim Dst As Range
-    Set Dst = Src.Offset(1, 0)
-    While Dst <> ""
-        If Dst = Src Then
-            With Dst.EntireRow
-                .Font.Bold = True
-                .Font.ColorIndex = 3
-            End With
-            Set Dst = Dst.Offset(1, 0)
-        Else
-            Set Src = Dst
-            Set Dst = Src.Offset(1, 0)
-        End If
-    Wend
-End Sub
-
-Function RC2ADDR(RowIdx As Integer, ColIdx As Integer) As String
-    Dim s As String
-    Dim Chars As String
-    Dim idx As Integer
-    idx = ColIdx
-    Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-    While idx > 1
-        s = Mid(Chars, idx Mod Len(Chars), 1) & s
-        idx = idx \ Len(Chars)
-    Wend
-    RC2ADDR = s & RowIdx
-End Function
-<<<<<<
-======================
-mbConstatnts
->>>>>>
-Attribute VB_Name = "mbConstatnts"
-Option Explicit
-
-Public Const UNKNOWN_AREA As String = "UNKNOWN_"
-Public Const NONAME_AREA As String = "*"
-
-Public Const WKS_AREAS_NAME As String = "GlobalList"
-Public Const WKS_PRICE_NAME As String = "OpPrices"
-Public Const WKS_COMPACT_NAME As String = "CompactPrices"
-Public Const WKS_TRAFFIC_NAME As String = "OpTraffic"
-Public Const WKS_FIX_AREAS_NAME As String = "GLFixed"
-Public Const WKS_HOME_NAME As String = "Home"
-
-Public Const Ofs_InPriceList As Integer = 2
-Public Const Ofs_ChkParent As Integer = 3
-Public Const Ofs_ChkChild As Integer = 4
-Public Const Ofs_ChkAlias As Integer = 5
-
-
-Public Const WKS_A3 As String = "A3"
-Public Const idx_sCode As Integer = 0
-Public Const idx_Code As Integer = 1
-Public Const idx_eDescr As Integer = 2
-Public Const idx_rDescr As Integer = 3
-Public Const idx_Price As Integer = 4
-Public Const idx_Traffic As Integer = 5
-Public Const idx_Calls As Integer = 6
-Public Const idx_Status As Integer = 7
-Public Const idx_Price2 As Integer = 8
-
-Public Const idx_DatTraffic As Integer = 2
-Public Const idx_DatCalls As Integer = 3
-
-Public Const idx_GLStatus As Integer = 4 ' ������� ������� ���� � ����� WKS_AREAS_NAME
-
-Public Const idx_GLZType As Integer = 5 ' ������� ���� ���� � ����� WKS_FIX_AREAS_NAME
-Public Const GLZType_Mobile As String = "M" ' ������ ��������� ��� � ����� WKS_FIX_AREAS_NAME
-Public Const GLZType_Static As String = "D" ' ������ ������� ��� � ����� WKS_FIX_AREAS_NAME
-
-Public Const ADD_CODE_ONLY As Integer = 0
-Public Const ADD_CODE_PRICE As Integer = 1
-Public Const ADD_CODE_TRAFFIC As Integer = 2
-
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet28
->>>>>>
-Attribute VB_Name = "Sheet28"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet29
->>>>>>
-Attribute VB_Name = "Sheet29"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mCompact
->>>>>>
-Attribute VB_Name = "mCompact"
-Option Explicit
-
-' ��� ������ ���� ��������� ���������� ���������� ��������� �������� ��������
-Private Const SHEET_NAME As String = "CompactPrices"
-Private Const START_CELL_ADDR As String = "W3"
-Private Const DST_CELL_ADDR As String = "B3"
-
-Sub zzz_CopactCodes()
-    Dim Src As Range
-    Dim Dst As Range
-    Dim r As Range
-    Dim AreaCount As Integer
-    Dim GlobalIdx As Integer
-    
-    
-    Set Src = ThisWorkbook.Worksheets(SHEET_NAME).Range(START_CELL_ADDR)
-    Set Dst = ThisWorkbook.Worksheets(SHEET_NAME).Range(DST_CELL_ADDR)
-    
-    While Dst <> ""
-        If Src <> "" Then
-            Dst = ""
-            Set r = Src
-            While r <> ""
-                If Dst = "" Then
-                    Dst = r
-                Else
-                    Dst = Dst & ";" & r
-                End If
-                Set r = r.Offset(0, 1)
-            Wend
-        End If
-        Set Dst = Dst.Offset(1, 0)
-        Set Src = Src.Offset(1, 0)
-    Wend
-    Dst.EntireColumn.AutoFit
-End Sub
-
-<<<<<<
-======================
-Sheet31
->>>>>>
-Attribute VB_Name = "Sheet31"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-zTest
->>>>>>
-Attribute VB_Name = "zTest"
-Sub z_CheckGLFixed()
-    Dim r As Range
-    Set r = ThisWorkbook.Worksheets(WKS_FIX_AREAS_NAME).Range(WKS_A3)
-    
-    MarkDublicates r
-End Sub
-
-Sub z_SetZoneType()
-    Dim r As Range
-    Set r = ThisWorkbook.Worksheets(WKS_FIX_AREAS_NAME).Range(WKS_A3)
-    While r <> ""
-        If InStr(r.Offset(0, idx_eDescr), "Cell") > 0 Then
-            r.Offset(0, idx_GLZType) = GLZType_Mobile
-        Else
-            r.Offset(0, idx_GLZType) = GLZType_Static
-        End If
-        Set r = r.Offset(1, 0)
-    Wend
-    With r.EntireColumn
-        .HorizontalAlignment = xlCenter
-        .AutoFit
-    End With
-    
-End Sub
-
-<<<<<<
-======================
-Sheet30
->>>>>>
-Attribute VB_Name = "Sheet30"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-mForecastPrice
->>>>>>
-Attribute VB_Name = "mForecastPrice"
-Option Explicit
-
-
-Sub Step_4a_SetParentZonePrices()
-    Dim i As Integer
-    Dim k As Integer
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-'        .Application.ScreenUpdating = False
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        i = 0
-        For k = 1 To ListsRange.Count
-            If ListsRange(k, Ofs_InPriceList) <> 1 Then
-                GoTo End_of_For_1
-            End If
-            
-            If ListsRange(k, Ofs_ChkParent) = 1 Then
-                Set DstRange = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3)
-                RestoreParentZonePrice DstRange, idx_PriceIN + i
-            End If
-            
-            i = i + 1
-End_of_For_1:
-        Next k
-        .Application.ScreenUpdating = True
-    End With
-End Sub
-
-Sub Step_4b_SetChildZonePrices()
-    Dim i As Integer
-    Dim k As Integer
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        i = 0
-        For k = 1 To ListsRange.Count
-            If ListsRange(k, Ofs_InPriceList) <> 1 Then
-                GoTo End_of_For_1
-            End If
-            
-            If ListsRange(k, Ofs_ChkChild) = 1 Then
-                Set DstRange = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3)
-                RestoreChildZonePrice DstRange, idx_PriceIN + i
-            End If
-            
-            i = i + 1
-End_of_For_1:
-        Next k
-        .Application.ScreenUpdating = True
-    End With
-End Sub
-
-Sub Step_4c_SetAliasZonePrices()
-    Dim i As Integer
-    Dim k As Integer
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        i = 0
-        For k = 1 To ListsRange.Count
-            If ListsRange(k, Ofs_InPriceList) <> 1 Then
-                GoTo End_of_For_1
-            End If
-            
-            If ListsRange(k, Ofs_ChkAlias) = 1 Then
-                Set DstRange = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3)
-                RestoreAliasZonePrice DstRange, idx_PriceIN + i
-            End If
-            
-            i = i + 1
-End_of_For_1:
-        Next k
-        .Application.ScreenUpdating = True
-    End With
-
-End Sub
-
-Sub RestoreAliasZonePrice(r As Range, PriceIndex As Integer)
-    Dim Src As Range
-    Dim Dst As Range
-    Dim IdxAliasPrice As Integer
-    Dim AreaCount As Integer
-    
-    Set Dst = r
-    
-    AreaCount = GetLinesCount(Dst)
-    
-    Set Dst = r
-    While Dst <> ""
-        If Dst.Offset(0, PriceIndex) = "-" Then
-            IdxAliasPrice = 1
-            Do
-                IdxAliasPrice = GetAliasDescrIdx(Dst.Offset(0, idx_eDescr), AreaCount, IdxAliasPrice)
-                If IdxAliasPrice = -1 Then
-                    Exit Do
-                End If
-                Set Src = r.Offset(IdxAliasPrice - 3, 0)
-                If Application.WorksheetFunction.IsNumber(Src.Offset(0, PriceIndex)) Then
-                    Exit Do
-                Else
-                    IdxAliasPrice = IdxAliasPrice + 1
-                End If
-            Loop
-            
-            If IdxAliasPrice > -1 Then
-                Set Src = r.Offset(IdxAliasPrice - 3, PriceIndex)
-                If Application.WorksheetFunction.IsNumber(Src) Then
-                    Dst.Offset(0, PriceIndex) = Src
-                    With Dst.Offset(0, PriceIndex)
-                        .Font.Bold = True
-                        .Font.Underline = xlUnderlineStyleSingle
-                        .Font.Italic = False
-                        .Font.ColorIndex = 10 ' green
-                    End With
-                End If
-            End If
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-Sub RestoreChildZonePrice(r As Range, PriceIndex As Integer)
-    Dim Dst As Range
-    Dim IdxParentPrice As Integer
-    Dim AreaCount As Integer
-    
-    Set Dst = r
-    
-    AreaCount = GetLinesCount(Dst)
-    
-    Set Dst = r
-    While Dst <> ""
-        If Dst.Offset(0, PriceIndex) = "-" Then
-            IdxParentPrice = FindGlobalAreaIdx(Dst, AreaCount)
-            If IdxParentPrice > -1 Then
-                Dst.Offset(0, PriceIndex) = r.Offset(IdxParentPrice - 3, PriceIndex)
-                With Dst.Offset(0, PriceIndex)
-                    .Font.Bold = False
-                    .Font.Italic = True
-                    .Font.ColorIndex = 29 ' magenta
-                End With
-            End If
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-Sub RestoreParentZonePrice(r As Range, PriceIndex As Integer)
-    Dim Src As Range
-    Dim Dst As Range
-    Dim IdxMaxPrice As Integer
-    
-    Set Dst = r
-    
-    While Dst <> ""
-        If Dst.Offset(0, PriceIndex) = "-" Then
-            Set Src = Dst.Offset(1, 0)
-            IdxMaxPrice = GetZoneMaxPrice(Dst, Src, PriceIndex)
-            If IdxMaxPrice >= 0 Then
-                Dst.Offset(0, PriceIndex) = Src.Offset(IdxMaxPrice, PriceIndex)
-                With Dst.Offset(0, PriceIndex)
-                    .Font.Bold = True
-                    .Font.Italic = True
-                    .Font.ColorIndex = 3 ' Red
-                End With
-            End If
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-Function GetZoneMaxPrice(Dst As Range, Src As Range, price_idx As Integer) As Integer
-    Dim s As String
-    Dim MaxPrice As Double
-    Dim MaxPriceIdx As Integer
-    
-    GetZoneMaxPrice = -1
-    MaxPrice = -1
-    MaxPriceIdx = 0
-    
-    While InStr(1, Src.Offset(MaxPriceIdx, 0), Dst) > 0
-        
-        If Application.WorksheetFunction.IsNumber(Src.Offset(MaxPriceIdx, price_idx)) Then
-            If MaxPrice < Src.Offset(MaxPriceIdx, price_idx) Then
-                MaxPrice = Src.Offset(MaxPriceIdx, price_idx)
-                GetZoneMaxPrice = MaxPriceIdx
-            End If
-        End If
-        MaxPriceIdx = MaxPriceIdx + 1
-    Wend
-End Function
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-mOpPrices
->>>>>>
-Attribute VB_Name = "mOpPrices"
-Option Explicit
-
-Public Const idx_PriceIN As Integer = 4
-
-Sub Step_3_Recalc_1st_Prices()
-    AnalyzeOpPricesData WKS_PRICE_NAME, "0.0000"
-End Sub
-
-
-
-Sub AnalyzeOpPricesData(wks_name As String, DATA_fmt As String)
-
-' ��������� ������ ��� �� ������� �����
-' ������� ���������� ������
-    ClearWorkArea (wks_name)
-    
-    ThisWorkbook.Worksheets(wks_name).Activate
-    ThisWorkbook.Worksheets(wks_name).Cells.Select
-    With Selection
-        .ClearContents
-        .Interior.ColorIndex = xlNone
-        .Font.Bold = False
-        .Font.ColorIndex = 0
-        .HorizontalAlignment = xlGeneral
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .ShrinkToFit = False
-        .MergeCells = False
-    End With
-    ThisWorkbook.Worksheets(wks_name).Range("A1").Select
-
-' ������������ ���������� �������� � �����-������
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim j As Integer
-    Dim k As Integer
-    Dim ListsRange_PriceCount As Integer
-    
-    Set ListsRange = ThisWorkbook.Worksheets(WKS_HOME_NAME).Range("OpList")
-    ListsRange_PriceCount = 0
-
-    For i = 1 To ListsRange.Count
-        If ListsRange(i, Ofs_InPriceList) = 1 Then
-            ListsRange_PriceCount = ListsRange_PriceCount + 1
-        End If
-    Next i
-
-
-
-' ����������� ��������� �������� �����
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-
-
-        With DstRange
-            .Offset(-2, idx_sCode) = "Common"
-            .Offset(-1, idx_sCode) = "sCode"
-            .Offset(-1, idx_Code) = "Code"
-            .Offset(-1, idx_eDescr) = "Descr_E"
-            .Offset(-1, idx_rDescr) = "Descr_R"
-            .Offset(-2, idx_PriceIN) = "Price (In)"
-            k = 1
-            For i = 1 To ListsRange.Count
-                If ListsRange(i, Ofs_InPriceList) = 1 Then
-                    .Offset(-1, k + idx_PriceIN - 1) = ListsRange(i, 1)
-                    k = k + 1
-                End If
-            Next i
-            .Offset(-2, idx_PriceIN + ListsRange_PriceCount) = "Stat of Price (IN)"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount) = "Count"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 1) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 1) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 2) = "Max"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 3) = "Avg"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 4) = "Down"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 5) = "Up"
-            .Offset(-2, idx_PriceIN + ListsRange_PriceCount + 6) = "Operators"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 6) = "Price"
-            .Offset(-2, idx_PriceIN + ListsRange_PriceCount + 7) = "Profit[x100%]"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 7) = "Avg"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 8) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange_PriceCount + 9) = "Max"
-            .Offset(-2, idx_PriceIN + ListsRange_PriceCount + 10) = "Op Profit[x100%] (Routing type 1)"
-            j = idx_PriceIN + ListsRange_PriceCount + 10
-            k = 1
-            For i = 1 To ListsRange.Count
-                If ListsRange(i, Ofs_InPriceList) = 1 Then
-                    .Offset(-1, k + j - 1) = ListsRange(i, 1)
-                    k = k + 1
-                End If
-            Next i
-            With .Offset(-2, 0).EntireRow
-                .HorizontalAlignment = xlLeft
-                .Font.Bold = True
-            End With
-            With .Offset(-1, 0).EntireRow
-                .HorizontalAlignment = xlCenter
-                .Font.Bold = True
-            End With
-            
-        End With
-
-' �������� ��������� ������ �� ������� ����
-        Set SrcRange = .Worksheets(WKS_FIX_AREAS_NAME).Range(WKS_A3)
-        
-        CopyAreasList DstRange, SrcRange
-        
-        Set SrcRange = .Worksheets(WKS_AREAS_NAME).Range(WKS_A3)
-        
-        Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-    End With
-
-' ������������ ����� ���������� ���
-
-    Dim AreaCount As Integer
-    AreaCount = GetLinesCount(DstRange)
-
-
-' ����������� ���������� ���������
-        
-    For i = 1 To 4
-        Set DstRange = ThisWorkbook.Worksheets(wks_name) _
-                    .Range(Cells(2, i), Cells(2 + AreaCount, i))
-        With DstRange
-            .EntireColumn.AutoFit
-            If i Mod 2 = 1 Then
-                .Interior.ColorIndex = 36 ' LightYellow
-            Else
-                .Interior.ColorIndex = xlNone  'White
-            End If
-        End With
-    Next i
-
-' ���������� ����/������ ���� ���������� � ��������� ����� ������ ��� �� �����
-' �������� ���� ���������� ��� ���
-
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        i = 1
-        For k = 1 To ListsRange.Count
-            If ListsRange(k, Ofs_InPriceList) <> 1 Then
-                GoTo End_of_For_1
-            End If
-            Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-            s = ListsRange.Cells(k, 1).Value
-            If wks_name = WKS_TRAFFIC_NAME Then
-                s = s & ".Data"
-            End If
-            
-            If SheetExist(s) Then
-                Set SrcRange = .Worksheets(s).Range(WKS_A3)
-    
-                AddOpPriceData DstRange, SrcRange, i - 1
-                
-            End If
-            
-' ����������� ���������� ���������
-            With .Worksheets(wks_name)
-                Set DstRange = .Range(.Cells(2, idx_Price + i), .Cells(2 + AreaCount, idx_Price + i))
-            End With
-            With DstRange
-                .NumberFormat = DATA_fmt
-                .Font.Bold = True
-                .HorizontalAlignment = xlCenter
-                .VerticalAlignment = xlBottom
-                .WrapText = False
-                .Orientation = 0
-                .AddIndent = False
-                .ShrinkToFit = False
-                .MergeCells = False
-                If i Mod 2 = 1 Then
-                    .Interior.ColorIndex = 36 ' LightYellow
-                Else
-                    .Interior.ColorIndex = xlNone  'White
-                End If
-            End With
-            i = i + 1
-End_of_For_1:
-        Next k
-        
-' ��������� ������ ����������� � ������� ���������
-
-        With Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, idx_Price + 1), .Cells(2 + AreaCount, idx_Price + ListsRange_PriceCount))
-        End With
-        
-'        DstRange.Select
-        
-        For Each SrcRange In DstRange
-            If SrcRange = "" Then
-                SrcRange = "-"
-            End If
-        Next SrcRange
-        
-        Set SrcRange = .Worksheets(wks_name).Range(WKS_A3)
-    End With
-    
-' ������������ ���������� �� �����
-    Set DstRange = ThisWorkbook.Worksheets(wks_name) _
-                .Range(WKS_A3).Offset(0, idx_PriceIN + ListsRange_PriceCount)
-                
-    DstRange.Select
-    
-    Dim Stat1stCol As Integer
-    Dim StatMinCol As Integer
-    Dim StatMaxCol As Integer
-    Dim StatAvgCol As Integer
-    Dim StatDnCol As Integer
-    Dim StatUpCol As Integer
-    
-    Dim offsetMinCol As Integer
-    Dim offsetMaxCol As Integer
-    Dim offsetAvgCol As Integer
-    Dim offsetUpCol As Integer
-    Dim offsetDnCol As Integer
-    Dim offsetPriceCol As Integer
-    Dim offsetAvgPtCol As Integer
-    Dim offsetMinPtCol As Integer
-    Dim offsetMaxPtCol As Integer
-    
-    
-    Stat1stCol = idx_PriceIN + ListsRange_PriceCount + 1
-    
-    offsetMinCol = 1
-    offsetMaxCol = 2
-    offsetAvgCol = 3
-    offsetUpCol = 4
-    offsetDnCol = 5
-    offsetPriceCol = 6
-    offsetAvgPtCol = 7
-    offsetMinPtCol = 8
-    offsetMaxPtCol = 9
-    
-    StatMinCol = Stat1stCol + offsetMinCol
-    StatMaxCol = Stat1stCol + offsetMaxCol
-    StatAvgCol = Stat1stCol + offsetAvgCol
-    StatUpCol = Stat1stCol + offsetUpCol
-    StatDnCol = Stat1stCol + offsetDnCol
-    
-    
-    For i = 0 To AreaCount - 1
-        s = RC2ADDR(i + 3, idx_PriceIN + 1) & ":" & RC2ADDR(i + 3, idx_PriceIN + ListsRange_PriceCount)
-        DstRange.Offset(i, 0).Formula = "=count(" & s & ")"
-        
-        Dim AnchorCell As String
-        AnchorCell = RC2ADDR(i + 3, Stat1stCol)
-        
-        DstRange.Offset(i, offsetMinCol).Formula = "=if(" & AnchorCell & ">0, min(" & s & "), ""-"")"
-        DstRange.Offset(i, offsetMaxCol).Formula = "=if(" & AnchorCell & ">0, max(" & s & "), ""-"")"
-        DstRange.Offset(i, offsetAvgCol).Formula = "=if(" & AnchorCell & ">0, average(" & s & "), ""-"")"
-        s = "=if(" & AnchorCell & ">0,(" & RC2ADDR(i + 3, StatAvgCol) & "-" & RC2ADDR(i + 3, StatMaxCol) & ")/" & RC2ADDR(i + 3, StatAvgCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetDnCol)
-            .Formula = s
-            .NumberFormat = "0.00%_);[Red](0.00)%"
-        End With
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, StatAvgCol) & "-" & RC2ADDR(i + 3, StatMinCol) & ")/" & RC2ADDR(i + 3, StatAvgCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetUpCol)
-            .Formula = s
-            .NumberFormat = "0.00%"
-        End With
-
-' ������ ��������� ���� �� �������.
-        s = "=if(" & AnchorCell & ">0, if(" & RC2ADDR(i + 3, StatAvgCol) & "<=Trigger, " & RC2ADDR(i + 3, StatAvgCol) & "+FixedV," & RC2ADDR(i + 3, StatAvgCol) & "* FIxedP), ""-"")"
-        With DstRange.Offset(i, offsetPriceCol)
-            .Formula = s
-            .NumberFormat = "0.000"
-        End With
-
-' ������ ������� � �������.
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & RC2ADDR(i + 3, StatAvgCol) & ")/" & RC2ADDR(i + 3, StatAvgCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetAvgPtCol)
-            .Formula = s
-            .HorizontalAlignment = xlCenter
-            .NumberFormat = "0.00%_);[Red](0.00)%"
-        End With
-
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & RC2ADDR(i + 3, StatMaxCol) & ")/" & RC2ADDR(i + 3, StatMaxCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetMinPtCol)
-            .Formula = s
-            .HorizontalAlignment = xlCenter
-            .NumberFormat = "0.00%_);[Red](0.00)%"
-        End With
-
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & RC2ADDR(i + 3, StatMinCol) & ")/" & RC2ADDR(i + 3, StatMinCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetMaxPtCol)
-            .Formula = s
-            .HorizontalAlignment = xlCenter
-            .NumberFormat = "0.00%_);[Red](0.00%)"
-        End With
-
-' ������ ������� � ������� �� ���������� (Routing type 1)
-        
-        j = 1
-        For k = 1 To ListsRange.Count
-            If ListsRange(k, Ofs_InPriceList) = 1 Then
-                AnchorCell = RC2ADDR(i + 3, idx_PriceIN + j)
-                s = "=if(isnumber(" & AnchorCell & "), (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & AnchorCell & ")/" & AnchorCell & ", ""-"")"
-                With DstRange.Offset(i, offsetMaxPtCol + j)
-                    .Formula = s
-                    .NumberFormat = "0.00%_);[Red](0.00)%"
-                End With
-                j = j + 1
-            End If
-        Next k
-    Next i
-
-
-' ����������� ���������� ���������
-' ����������
-    For i = 0 To 5
-        With ThisWorkbook.Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, Stat1stCol + i), .Cells(2 + AreaCount, Stat1stCol + i))
-        End With
-        With DstRange
-            If i > 0 And i <= 3 Then
-                .NumberFormat = DATA_fmt
-            End If
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-            .WrapText = False
-            .Orientation = 0
-            .AddIndent = False
-            .ShrinkToFit = False
-            .MergeCells = False
-            If i Mod 2 = 0 Then
-                .Interior.ColorIndex = 35 ' LightLightGreen
-            Else
-                .Interior.ColorIndex = 34  ' LightLightBlue
-            End If
-        End With
-    Next i
-
-' ������ ������� "Operators price"
-
-    With ThisWorkbook.Worksheets(wks_name)
-        Set DstRange = .Range(.Cells(1, Stat1stCol + offsetPriceCol), .Cells(2 + AreaCount, Stat1stCol + offsetPriceCol))
-        With DstRange
-            .Interior.ColorIndex = 36 ' LightYellow
-            .Font.ColorIndex = 10
-            .Font.Bold = True
-            .NumberFormat = "0.0000"
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-        End With
-    End With
-
-' ������ ������� � ������� �� ���������� (Routing type 1)
-    For j = 1 To ListsRange_PriceCount
-        With ThisWorkbook.Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, Stat1stCol + offsetMaxPtCol + j), .Cells(2 + AreaCount, Stat1stCol + offsetMaxPtCol + j))
-        End With
-        With DstRange
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-            .WrapText = False
-            .Orientation = 0
-            .AddIndent = False
-            .ShrinkToFit = False
-            .MergeCells = False
-            If j Mod 2 = 0 Then
-                .Interior.ColorIndex = 34  ' LightLightBlue
-            Else
-                .Interior.ColorIndex = 35 ' LightLightGreen
-            End If
-        End With
-    Next j
-    Application.ScreenUpdating = True
-End Sub
-
-Sub CopyAreasList(Dst As Range, Src As Range)
-    While Src <> ""
-        Dst.Offset(0, idx_sCode).Value = Src.Offset(0, idx_sCode).Value
-        Dst.Offset(0, idx_Code).Value = Src.Offset(0, idx_Code).Value
-        Dst.Offset(0, idx_eDescr).Value = Src.Offset(0, idx_eDescr).Value
-        Dst.Offset(0, idx_rDescr).Value = Src.Offset(0, idx_rDescr).Value
-        Set Src = Src.Offset(1, 0)
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-
-Sub AddOpPriceData(Dst As Range, Src As Range, index As Integer)
-    While Src <> "" And Dst <> ""
-        If Dst = Src Then
-            Dst.Offset(0, idx_Price + index) = Src.Offset(0, idx_Price)
-            Set Dst = Dst.Offset(1, 0)
-        End If
-        If Dst > Src Then
-            Set Src = Src.Offset(1, 0)
-        End If
-        If Dst < Src Then
-            Set Dst = Dst.Offset(1, 0)
-        End If
-    Wend
-End Sub
-
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet27
->>>>>>
-Attribute VB_Name = "Sheet27"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-mGlobalList
->>>>>>
-Attribute VB_Name = "mGlobalList"
-Option Explicit
-
-
-
-
-Sub Step_1_BuildWorkPriceLists()
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            CreateComSheet (s)
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            Set SrcRange = .Worksheets(s & ".Tarif").Range(WKS_A3)
-            
-            MarkDublicates SrcRange
-            
-            Set SrcRange = .Worksheets(s & ".Tarif").Range(WKS_A3)
-            AddOpArea DstRange, SrcRange, ADD_CODE_PRICE
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            
-            If SheetExist(s & ".Data") Then
-                Set SrcRange = .Worksheets(s & ".Data").Range(WKS_A3)
-                AddOpArea DstRange, SrcRange, ADD_CODE_TRAFFIC
-            End If
-            
-' ����������� ����� ������:
-' 00 - �� ���������, �� ������������
-' 01 - �� ���������, ������������
-' 10 - ���������, �� ������������
-' 11 - ���������, ������������
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            While DstRange <> ""
-                If DstRange.Offset(0, idx_Price) = 0 Or DstRange.Offset(0, idx_Price) = "-" Then
-                    If DstRange.Offset(0, idx_Traffic) = 0 Then
-                        DstRange.Offset(0, idx_Status) = 0
-                    Else
-                        DstRange.Offset(0, idx_Status) = 1
-                    End If
-                Else
-                    If DstRange.Offset(0, idx_Traffic) = 0 Then
-                        DstRange.Offset(0, idx_Status) = 10
-                    Else
-                        DstRange.Offset(0, idx_Status) = 11
-                    End If
-                End If
-                Set DstRange = DstRange.Offset(1, 0)
-            Wend
-                
-            With .Worksheets(s)
-                With .Columns("A:H")
-                    .HorizontalAlignment = xlHAlignGeneral
-                    .VerticalAlignment = xlBottom
-                    .WrapText = False
-                    .Orientation = 0
-                    .AddIndent = False
-                    .ShrinkToFit = True
-                    .MergeCells = False
-                End With
-                .Columns("A:A").HorizontalAlignment = xlLeft
-                .Columns("B:B").NumberFormat = "#"
-                With .Rows("2:2")
-                    .Font.Bold = False
-                    .WrapText = False
-                    .HorizontalAlignment = xlCenter
-                End With
-                With .Columns("G:G")
-                    .HorizontalAlignment = xlHAlignCenter
-                    .NumberFormat = "0#"
-                End With
-            End With
-            MarkDublicates (.Worksheets(s).Range(WKS_A3))
-        Next i
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-        
-    End With
-
-End Sub
-
-Sub Step_2_CreateGlobalCodeList()
-
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-' ������� ���������� ������
-    ClearWorkArea WKS_AREAS_NAME, "A1"
-    
-' ��������� ����� ������ ���
-
-    
-    BuildAreasList (WKS_AREAS_NAME)
-    
-    BuildAreasStatus (WKS_AREAS_NAME)
-
-    
-End Sub
-
-Sub BuildAreasList(DstName As String)
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-        
-' ��������� ������ ���������
-        With .Worksheets(DstName)
-            .Range("a1") = DstName
-            With .Range("a2")
-                .Offset(0, idx_sCode) = "sCode"
-                .Offset(0, idx_Code) = "Code"
-                .Offset(0, idx_eDescr) = "Descr_E"
-                .Offset(0, idx_rDescr) = "Descr_R"
-            End With
-            With .Rows("2:2")
-                .Font.Bold = False
-                .WrapText = False
-                .HorizontalAlignment = xlCenter
-            End With
-        End With
-        
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            If SheetExist(s) Then
-                Set DstRange = .Worksheets(WKS_AREAS_NAME).Range(WKS_A3)
-                Set SrcRange = .Worksheets(s).Range(WKS_A3)
-        
-                AddGlobalOpArea DstRange, SrcRange
-            End If
-        Next i
-        Set SrcRange = .Worksheets(DstName).Range(WKS_A3)
-        .Worksheets(DstName).Select
-                
-        MarkDublicates (.Worksheets(DstName).Range(WKS_A3))
-        
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-    End With
-End Sub
-
-Sub AddGlobalOpArea(Dst As Range, Src As Range)
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst.Offset(0, idx_sCode) = Src.Offset(0, idx_sCode)
-            Dst.Offset(0, idx_Code) = Src.Offset(0, idx_Code)
-        End If
-        If Dst = Src Then
-            CheckNameOpArea Dst, Src, ADD_CODE_ONLY
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    
-    Dst.Worksheet.Columns("A:H").AutoFit
-    
-    Set Dst = Dst.Worksheet.Range(WKS_A3)
-    
-End Sub
-
-Sub CheckNameOpArea(Dst As Range, Src As Range, ByVal add_type As Integer)
-    
-    Dim Exist_SrcEng As Boolean
-    Dim Exist_SrcRus As Boolean
-    Dim Exist_DstEng As Boolean
-    Dim Exist_DstRus As Boolean
-    
-    Dim Unknown_Src As Boolean
-    Dim Unknown_Dst As Boolean
-    
-    With Dst
-        Exist_DstEng = .Offset(0, idx_eDescr) <> "" And .Offset(0, idx_eDescr) <> UNKNOWN_AREA And .Offset(0, idx_eDescr) <> NONAME_AREA
-        Exist_DstRus = .Offset(0, idx_rDescr) <> "" And .Offset(0, idx_rDescr) <> UNKNOWN_AREA And .Offset(0, idx_rDescr) <> NONAME_AREA
-    End With
-    
-    Unknown_Dst = Not (Exist_DstEng Or Exist_DstRus)
-    
-    If add_type = ADD_CODE_TRAFFIC Then
-        If Unknown_Dst Then
-            Dst.Offset(0, idx_eDescr) = UNKNOWN_AREA & Dst.Offset(0, idx_Code)
-            Dst.Offset(0, idx_rDescr) = UNKNOWN_AREA & Dst.Offset(0, idx_Code)
-        End If
-        Exit Sub
-    End If
-    
-    With Src
-        Exist_SrcEng = .Offset(0, idx_eDescr) <> "" And .Offset(0, idx_eDescr) <> UNKNOWN_AREA And .Offset(0, idx_eDescr) <> NONAME_AREA
-        Exist_SrcRus = .Offset(0, idx_rDescr) <> "" And .Offset(0, idx_rDescr) <> UNKNOWN_AREA And .Offset(0, idx_rDescr) <> NONAME_AREA
-    End With
-    
-    Unknown_Src = Not (Exist_SrcEng Or Exist_SrcRus)
-    
-    If Unknown_Src And Unknown_Dst Then
-        Dst.Offset(0, idx_eDescr) = UNKNOWN_AREA
-        Dst.Offset(0, idx_rDescr) = UNKNOWN_AREA
-        Exit Sub
-    End If
-    
-    If Unknown_Src Then
-        If Not Exist_DstRus Then
-            Dst.Offset(0, idx_rDescr) = NONAME_AREA
-        End If
-        If Not Exist_DstEng Then
-            Dst.Offset(0, idx_eDescr) = NONAME_AREA
-        End If
-    Else
-        If Not Exist_DstEng Then
-            If Exist_SrcEng Then
-                Dst.Offset(0, idx_eDescr) = Src.Offset(0, idx_eDescr)
-            Else
-                Dst.Offset(0, idx_eDescr) = NONAME_AREA
-            End If
-        End If
-        If Not Exist_DstRus Then
-            If Exist_SrcRus Then
-                Dst.Offset(0, idx_rDescr) = Src.Offset(0, idx_rDescr)
-            Else
-                Dst.Offset(0, idx_rDescr) = NONAME_AREA
-            End If
-        End If
-    End If
-End Sub
-
-Sub AddOpArea(Dst As Range, Src As Range, Optional add_type = ADD_CODE_ONLY)
-    
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst.Offset(0, idx_sCode) = Src.Offset(0, idx_sCode)
-            Dst.Offset(0, idx_Code) = Src.Offset(0, idx_Code)
-        End If
-        If Dst = Src Then
-            Select Case add_type
-                Case ADD_CODE_PRICE
-                    Dst.Offset(0, idx_Price) = Src.Offset(0, idx_Price)
-                    If Dst.Offset(0, idx_Price) = "" Then
-                        Dst.Offset(0, idx_Price) = "-"
-                    End If
-                Case ADD_CODE_TRAFFIC
-                    Dst.Offset(0, idx_Traffic) = Src.Offset(0, idx_DatTraffic)
-                    Dst.Offset(0, idx_Calls) = Src.Offset(0, idx_DatCalls)
-                    
-            End Select
-            
-            CheckNameOpArea Dst, Src, add_type
-                        
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    
-    Select Case add_type
-        Case ADD_CODE_PRICE
-            Dst.Worksheet.Columns("E:E").NumberFormat = "0.0000"
-        Case ADD_CODE_TRAFFIC
-            Dst.Worksheet.Columns("F:F").NumberFormat = "0.00"
-    End Select
-    
-    Dst.Worksheet.Columns("A:H").AutoFit
-    
-    Set Dst = Dst.Worksheet.Range("A1")
-End Sub
-
-Sub BuildAreasStatus(wks_name As String)
-    Dim rSrc As Range
-    Dim rDst As Range
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim j As Integer
-    Dim s As String
-    Dim WS_Name As String
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        
-' ��������� ������ ������
-
-        Dim AreaCount As Integer
-
-        Set rDst = .Worksheets(wks_name).Range(WKS_A3)
-        
-        AreaCount = GetLinesCount(rDst) + 3
-
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        Set rDst = .Worksheets(wks_name).Range(WKS_A3)
-        j = 3
-        
-        For i = 1 To ListsRange.Count
-            rDst.Offset(-1, i + idx_GLStatus).Formula = ListsRange(i, 1)
-        Next i
-        
-' ��������� ������� ��� ��� ������ ����������
-        While rDst <> ""
-            For i = 1 To ListsRange.Count
-                WS_Name = ListsRange(i, 1)
-                If SheetExist(WS_Name) Then
-                    s = "INDEX(" & WS_Name & "!G1:$G$" & AreaCount & ", MATCH($A" & j & "," & WS_Name & "!$A$1:$A$" & AreaCount & ",0), 1)"
-                    s = "=if(iserror(" & s & "), ""-""," & s & ")"
-                Else
-                    s = "-"
-                End If
-                rDst.Offset(0, i + idx_GLStatus).Formula = s
-                rDst.Offset(0, i + idx_GLStatus).NumberFormat = "0#"
-            Next i
-            j = j + 1
-            Set rDst = rDst.Offset(1, 0)
-        Wend
-        
-' ����������� ���������
-        For i = 0 To ListsRange.Count
-            With rDst.Offset(-1, i + idx_GLStatus).EntireColumn
-                .HorizontalAlignment = xlCenter
-                .ShrinkToFit = True
-            End With
-        Next i
-
-' ������������ �������� ���
-
-        With .Worksheets(wks_name)
-            Set rDst = .Range(.Cells(3, 1), .Cells(AreaCount, 1))
-        End With
-
-        Set rSrc = .Worksheets(WKS_FIX_AREAS_NAME).Range(WKS_A3)
-        
-        AreaCount = GetLinesCount(rSrc) + 3
-
-        With .Worksheets(WKS_FIX_AREAS_NAME)
-            Set rSrc = .Range(.Cells(2, 1), .Cells(AreaCount, 1))
-        End With
-
-        Dim b As Range
-        Dim c As Range
-        For Each c In rDst
-            Set b = rSrc.Find(c, LookIn:=xlValues, MatchByte:=True)
-            If Not b Is Nothing Then
-                If c.Offset(0, idx_eDescr) <> b.Offset(0, idx_eDescr) Or c.Offset(0, idx_rDescr) <> b.Offset(0, idx_rDescr) Then
-                    c.Offset(0, idx_eDescr) = b.Offset(0, idx_eDescr)
-                    c.Offset(0, idx_rDescr) = b.Offset(0, idx_rDescr)
-                    c.Offset(0, idx_GLStatus) = "Fixed"
-                    With c.EntireRow
-                        .Font.Bold = True
-                        .Font.ColorIndex = xlColorIndexAutomatic
-                    End With
-                Else
-                    c.Offset(0, idx_GLStatus) = "-"
-                End If
-            Else
-                If c.Offset(0, idx_sCode) <> "" Then
-                    Dim FixedList As Range
-                    c.Offset(0, idx_GLStatus) = "New"
-                    With c.EntireRow
-                        .Font.Bold = True
-                        .Font.ColorIndex = 3 ' Red
-                    End With
-                End If
-                
-'                Set Fixed
-            End If
-        Next c
-        
-        Application.ScreenUpdating = True
-        
-    End With
-End Sub
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Sub ClearWorkArea(DstName As String, Optional StartRange As String = WKS_A3)
-    Dim DstRange As Range
-    With ThisWorkbook
-       
-        Set DstRange = .Worksheets(DstName).Range(StartRange)
-        Worksheets(DstName).Select
-        DstRange.Select
-        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
-        Range(Selection, Selection.End(xlDown)).Select
-        Selection.Delete Shift:=xlUp
-        Selection.Font.Bold = False
-        Selection.Font.ColorIndex = xlColorIndexAutomatic
-        Set DstRange = .Worksheets(DstName).Range(StartRange)
-        DstRange.Select
-    End With
-End Sub
-
-Function SheetExist(SheetName As String) As Boolean
-    Dim Count, i As Integer
-
-    Count = ThisWorkbook.Sheets.Count
-    SheetExist = False
-    For i = 1 To Count
-        If ThisWorkbook.Sheets(i).Name = SheetName Then
-            SheetExist = True
-            i = Count
-        End If
-    Next i
-End Function
-
-Function GetLinesCount(r As Range) As Integer
-
-    Dim LinesCount As Integer
-    Dim rr As Range
-    
-    Set rr = r
-    
-    LinesCount = 0
-
-    While rr <> ""
-        LinesCount = LinesCount + 1
-        Set rr = rr.Offset(1, 0)
-    Wend
-    
-    GetLinesCount = LinesCount
-End Function
-
-Sub CreateComSheet(wks_name As String)
-    Dim theRange As Range
-    With ThisWorkbook
-        If Not SheetExist(wks_name) Then
-            .Sheets.Add.Name = wks_name
-        End If
-            
-        .Sheets(wks_name).Visible = True
-        .Sheets(wks_name).Select
-        Cells.Select
-        Selection.ClearContents
-        Selection.Interior.ColorIndex = xlNone
-        Selection.Borders(xlLeft).LineStyle = xlNone
-        Selection.Borders(xlRight).LineStyle = xlNone
-        Selection.Borders(xlTop).LineStyle = xlNone
-        Selection.Borders(xlBottom).LineStyle = xlNone
-        Selection.BorderAround LineStyle:=xlNone
-        Selection.Font.ColorIndex = 0
-        Selection.EntireColumn.ColumnWidth = ActiveSheet.StandardWidth
-    
-        With .Worksheets(wks_name)
-            .Range("a1") = wks_name
-            With .Range("a2")
-                .Offset(0, idx_sCode) = "sCode"
-                .Offset(0, idx_Code) = "Code"
-                .Offset(0, idx_eDescr) = "Descr_E"
-                .Offset(0, idx_rDescr) = "Descr_R"
-                .Offset(0, idx_Price) = "Price"
-                .Offset(0, idx_Traffic) = "Traffic"
-                .Offset(0, idx_Calls) = "Calls"
-                .Offset(0, idx_Status) = "Status"
-            End With
-            With .Rows("2:2")
-                .Font.Bold = False
-                .WrapText = False
-                .HorizontalAlignment = xlCenter
-            End With
-            .Range("A1").Select
-        End With
-    End With
-End Sub
-
-' ���������� index ����� ���� �������� �� �������������� ������ ���� ���, ������� �� StartIndex
-' ������ ��� ���� Russia, Moscow ���������� ����� �������� ���� � ������ Russia
-' ���������� �������:
-' -1 ����������� ���� ��� �������� ����������
-' > 0 - ���������� ���� ��������� ���������� ���� � ������
-
-Function GetAliasDescrIdx(Dst As Range, AreaCount As Integer, Optional StartIndex As Integer = 1) As Integer
-    Dim s As String
-    Dim idx As Integer
-    
-    s = Dst
-    idx = StartIndex
-    
-    GetAliasDescrIdx = -1
-    
-    With Dst.Worksheet
-        Do
-            idx = FindVIndex(Dst.EntireColumn, AreaCount, s, idx)
-            If idx > 0 Then
-                If idx <> Dst.Row Then
-                    GetAliasDescrIdx = idx
-                    Exit Do
-                Else
-                    idx = idx + 1
-                End If
-            End If
-        Loop While (idx <> -1)
-    End With
-End Function
-
-' ���������� index ����������� ����� ���� �� �������������� ������ ���� ���
-' ������ ��� ���� Russia, Moscow ���������� ����� �������� ���� � ������ Russia
-' ���������� �������:
-' -1 ����������� ���� ��� �������� ����������
-' > 0 - ���������� ���� ��������� ���������� ���� � ������
-
-Function GetGlobalDescrIdx(Dst As Range, AreaCount As Integer, Optional StartIndex As Integer = 1) As Integer
-    Dim iStrPos As Integer
-    Dim s As String
-    Dim idx As Integer
-    
-    s = Dst
-    idx = StartIndex
-    iStrPos = Len(s)
-    
-    GetGlobalDescrIdx = -1
-    
-    With Dst.Worksheet
-        Do
-            idx = FindVIndex(Dst.EntireColumn, AreaCount, s, idx)
-            If idx > 0 Then
-                If idx <> Dst.Row Then
-                    GetGlobalDescrIdx = idx
-                    Exit Do
-                Else
-                    idx = idx + 1
-                End If
-            Else
-                iStrPos = InStrRev(s, " ") - 1
-                If iStrPos = -1 Then
-                    iStrPos = InStrRev(s, ",") - 1
-                End If
-                If iStrPos <> -1 Then
-                    idx = 1
-                    s = Left(s, iStrPos)
-                End If
-            End If
-        Loop While (idx <> -1 And iStrPos <> 0)
-    End With
-End Function
-
-' ���������� index ���������� ���� �� �������������� ������ ���
-' ������ ��� ���� s709643 ���������� ����� �������� ���� s7096 � s7
-
-' ���������� �������:
-' -1 ����������� ���� �������� ����������
-' > 0 - ������ � ������ ���������� ����
-
-Function FindGlobalAreaIdx(Dst As Range, AreaCount As Integer) As Integer
-    Dim iStrPos As Integer
-    Dim s As String
-    Dim idx As Integer
-    
-    FindGlobalAreaIdx = -1
-    
-    s = Dst
-    If s = "" Then
-        Exit Function
-    End If
-    
-    idx = 1
-    iStrPos = Len(s) - 1
-    
-    With Dst.Worksheet
-        s = Left(s, iStrPos)
-        Do
-            idx = FindVIndex(Dst.EntireColumn, AreaCount, s, idx)
-            If idx > 0 Then
-                If idx <> Dst.Row Then
-                    FindGlobalAreaIdx = idx
-                    Exit Do
-                Else
-                    idx = idx + 1
-                End If
-            Else
-                iStrPos = iStrPos - 1
-                If iStrPos > 1 Then
-                    s = Left(s, iStrPos)
-                    idx = 1
-                End If
-            End If
-        Loop While (idx <> -1 And iStrPos <> 0)
-    End With
-End Function
-
-' ���������� index ���������� ���� �� �������������� ������ ���
-' ������ ��� ���� 709643 ���������� ����� �������� ���� 7096 � 7
-
-' ���������� �������:
-' -1 ����������� ���� �������� ����������
-' > 0 - ������ � ������ ���������� ����
-
-Function GetGlobalAreaIdx(wks_name As String, range_name As String, AreaCount As Integer, scDst) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim Answer As Integer
-    
-    GetGlobalAreaIdx = -1
-    
-    With ThisWorkbook.Worksheets(wks_name)
-        For i = Len(scDst) To 2 Step -1
-            s = Left(scDst, i)
-            Answer = FindVIndex(.Range(range_name), AreaCount, s)
-            If Answer > 0 Then
-                GetGlobalAreaIdx = Answer
-                Exit Function
-            End If
-        Next i
-    End With
-End Function
-
-Function FindVIndex(Src As Range, AreaCount As Integer, s As String, Optional Start As Integer = 1) As Integer
-    Dim l As Long
-    FindVIndex = -1
-    For l = Start To AreaCount
-        If s = Src.Cells(l, 1) Then
-            FindVIndex = l
-            Exit Function
-        End If
-    Next l
-End Function
-
-Sub MarkDublicates(Src As Range)
-    Dim Dst As Range
-    Set Dst = Src.Offset(1, 0)
-    While Dst <> ""
-        If Dst = Src Then
-            With Dst.EntireRow
-                .Font.Bold = True
-                .Font.ColorIndex = 3
-            End With
-            Set Dst = Dst.Offset(1, 0)
-        Else
-            Set Src = Dst
-            Set Dst = Src.Offset(1, 0)
-        End If
-    Wend
-End Sub
-
-Function RC2ADDR(RowIdx As Integer, ColIdx As Integer) As String
-    Dim s As String
-    Dim Chars As String
-    Dim idx As Integer
-    idx = ColIdx
-    Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-    While idx > 1
-        s = Mid(Chars, idx Mod Len(Chars), 1) & s
-        idx = idx \ Len(Chars)
-    Wend
-    RC2ADDR = s & RowIdx
-End Function
-<<<<<<
-======================
-mbConstatnts
->>>>>>
-Attribute VB_Name = "mbConstatnts"
-Option Explicit
-
-Public Const UNKNOWN_AREA As String = "UNKNOWN_"
-Public Const NONAME_AREA As String = "*"
-
-Public Const WKS_AREAS_NAME As String = "GlobalList"
-Public Const WKS_PRICE_NAME As String = "OpPrices"
-Public Const WKS_COMPACT_NAME As String = "CompactPrices"
-Public Const WKS_TRAFFIC_NAME As String = "OpTraffic"
-Public Const WKS_FIX_AREAS_NAME As String = "GLFixed"
-Public Const WKS_HOME_NAME As String = "Home"
-
-Public Const Ofs_InPriceList As Integer = 2
-Public Const Ofs_ChkParent As Integer = 3
-Public Const Ofs_ChkChild As Integer = 4
-Public Const Ofs_ChkAlias As Integer = 5
-
-
-Public Const WKS_A3 As String = "A3"
-Public Const idx_sCode As Integer = 0
-Public Const idx_Code As Integer = 1
-Public Const idx_eDescr As Integer = 2
-Public Const idx_rDescr As Integer = 3
-Public Const idx_Price As Integer = 4
-Public Const idx_Traffic As Integer = 5
-Public Const idx_Calls As Integer = 6
-Public Const idx_Status As Integer = 7
-Public Const idx_Price2 As Integer = 8
-
-Public Const idx_DatTraffic As Integer = 2
-Public Const idx_DatCalls As Integer = 3
-
-Public Const idx_GLStatus As Integer = 4 ' ������� ������� ���� � ����� WKS_AREAS_NAME
-
-Public Const idx_GLZType As Integer = 5 ' ������� ���� ���� � ����� WKS_FIX_AREAS_NAME
-Public Const GLZType_Mobile As String = "M" ' ������ ��������� ��� � ����� WKS_FIX_AREAS_NAME
-Public Const GLZType_Static As String = "D" ' ������ ������� ��� � ����� WKS_FIX_AREAS_NAME
-
-Public Const ADD_CODE_ONLY As Integer = 0
-Public Const ADD_CODE_PRICE As Integer = 1
-Public Const ADD_CODE_TRAFFIC As Integer = 2
-
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet28
->>>>>>
-Attribute VB_Name = "Sheet28"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet29
->>>>>>
-Attribute VB_Name = "Sheet29"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mCompact
->>>>>>
-Attribute VB_Name = "mCompact"
-Option Explicit
-
-' ��� ������ ���� ��������� ���������� ���������� ��������� �������� ��������
-Private Const SHEET_NAME As String = "CompactPrices"
-Private Const START_CELL_ADDR As String = "W3"
-Private Const DST_CELL_ADDR As String = "B3"
-
-Sub zzz_CopactCodes()
-    Dim Src As Range
-    Dim Dst As Range
-    Dim r As Range
-    Dim AreaCount As Integer
-    Dim GlobalIdx As Integer
-    
-    
-    Set Src = ThisWorkbook.Worksheets(SHEET_NAME).Range(START_CELL_ADDR)
-    Set Dst = ThisWorkbook.Worksheets(SHEET_NAME).Range(DST_CELL_ADDR)
-    
-    While Dst <> ""
-        If Src <> "" Then
-            Dst = ""
-            Set r = Src
-            While r <> ""
-                If Dst = "" Then
-                    Dst = r
-                Else
-                    Dst = Dst & ";" & r
-                End If
-                Set r = r.Offset(0, 1)
-            Wend
-        End If
-        Set Dst = Dst.Offset(1, 0)
-        Set Src = Src.Offset(1, 0)
-    Wend
-    Dst.EntireColumn.AutoFit
-End Sub
-
-<<<<<<
-======================
-Sheet31
->>>>>>
-Attribute VB_Name = "Sheet31"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-zTest
->>>>>>
-Attribute VB_Name = "zTest"
-Sub z_CheckGLFixed()
-    Dim r As Range
-    Set r = ThisWorkbook.Worksheets(WKS_FIX_AREAS_NAME).Range(WKS_A3)
-    
-    MarkDublicates r
-End Sub
-
-Sub z_SetZoneType()
-    Dim r As Range
-    Set r = ThisWorkbook.Worksheets(WKS_FIX_AREAS_NAME).Range(WKS_A3)
-    While r <> ""
-        If InStr(r.Offset(0, idx_eDescr), "Cell") > 0 Then
-            r.Offset(0, idx_GLZType) = GLZType_Mobile
-        Else
-            r.Offset(0, idx_GLZType) = GLZType_Static
-        End If
-        Set r = r.Offset(1, 0)
-    Wend
-    With r.EntireColumn
-        .HorizontalAlignment = xlCenter
-        .AutoFit
-    End With
-    
-End Sub
-
-<<<<<<
-======================
-Sheet30
->>>>>>
-Attribute VB_Name = "Sheet30"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-Type PriceRecord
-    Aria As String
-    Description As String
-    Description2 As String
-    Price As Double
-End Type
-
-Dim SourcePrData() As PriceRecord
-
-Sub a()
-    ReDim SourcePrData(1 To 5)
-    Erase SourcePrData
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-ForecastPrice
->>>>>>
-Attribute VB_Name = "ForecastPrice"
-Option Explicit
-
-Sub Step_4_ForecastBlankCodes()
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim AreaCount As Integer
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim r As Range
-        
-        AreaCount = 0
-        Set r = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3)
-        AreaCount = GetLinesCount(r)
-
-        For i = 1 To ListsRange.Count
-            Set r = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3).Offset(0, idx_PriceIN + i - 1)
-            DoForecast r, AreaCount
-        Next i
-    End With
-    MsgBox "Step_4_ForecastBlankCodes is done!"
-End Sub
-
-
-Sub DoForecast(Src As Range, AreaCount As Integer)
-    Dim i As Integer
-    Dim Dst As Range
-    Dim scDst As String
-    Dim scDstDscr As String
-    
-    Static PriceAvailable As Boolean
-    
-    With ThisWorkbook
-        Set Dst = Src.Offset(1, 0)
-    
-        For i = 1 To AreaCount - 1
-            PriceAvailable = Application.WorksheetFunction.IsNumber(Dst)
-            
-            If PriceAvailable = True Then
-                Set Src = Dst
-                Set Dst = Src.Offset(1, 0)
-            Else
-                Dim Idx As Integer
-                
-
-'==========================================================================
-                Dim iStrPos As Integer
-                Dim s As String
-                
-                s = Dst.Worksheet.Range("C:C").Cells(Dst.Row, 1)
-                iStrPos = Len(s)
-                With Dst.Worksheet
-                    Idx = 1
-                    
-                    Do
-                        Idx = FindVIndex(Dst.Worksheet.Range("C:C"), AreaCount, s, Idx)
-                        If Idx > 0 Then
-                            If Application.WorksheetFunction.IsNumber(.Cells(Idx, Dst.Column)) Then
-                                Exit Do
-                            Else
-                                Idx = Idx + 1
-                            End If
-                        Else
-                            iStrPos = InStrRev(s, " ") - 1
-                            If iStrPos = -1 Then
-                                iStrPos = InStrRev(s, ",") - 1
-                            End If
-                            If iStrPos <> -1 Then
-                                Idx = 1
-                                s = Left(s, iStrPos)
-                            End If
-                        End If
-                    Loop While (Idx <> -1 And iStrPos <> 0)
-                End With
-'==========================================================================
-                
-                If Idx = -1 Then
-                    scDst = .Worksheets(WKS_PRICE_NAME).Range("A:A").Cells(Dst.Row, 1)
-                    Idx = GetGlobalAreaIdx(WKS_PRICE_NAME, "A:A", AreaCount, Left(scDst, Len(scDst) - 1))
-                    If Idx > 0 Then
-                        If Application.WorksheetFunction.IsNumber(.Worksheets(WKS_PRICE_NAME).Cells(Idx, Dst.Column)) = False Then
-                            Idx = -1
-                        End If
-                    End If
-                End If
-                
-                If Idx <> -1 Then
-                    Set Src = .Worksheets(WKS_PRICE_NAME).Cells(Idx, Src.Column)
-                    
-                    Dst = Src
-                    Dst.Font.Bold = False
-                    Dst.Font.ColorIndex = 29 ' magenta
-                    Set Dst = Dst.Offset(1, 0)
-                Else
-'                    Dst = "*"
-'                    Dst.Font.ColorIndex = xlColorIndexAutomatic
-'                    Dst.Font.Bold = True
-                    Set Dst = Dst.Offset(1, 0)
-                End If
-            End If
-        Next i
-    End With
-End Sub
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-mAnalisys
->>>>>>
-Attribute VB_Name = "mAnalisys"
-Option Explicit
-
-Public Const idx_PriceIN As Integer = 4
-
-
-Sub AnalyzeOpPricesData(wks_name As String, DATA_fmt As String)
-
-' ��������� ������ ��� �� ������� �����
-' ������� ���������� ������
-    ClearWorkArea (wks_name)
-    
-    ThisWorkbook.Worksheets(wks_name).Activate
-    ThisWorkbook.Worksheets(wks_name).Cells.Select
-    With Selection
-        .ClearContents
-        .Interior.ColorIndex = xlNone
-        .Font.Bold = False
-        .Font.ColorIndex = 0
-        .HorizontalAlignment = xlGeneral
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .ShrinkToFit = False
-        .MergeCells = False
-    End With
-    ThisWorkbook.Worksheets(wks_name).Range("A1").Select
-' ����������� ��������� �������� �����
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim j As Integer
-
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-        Set SrcRange = .Worksheets(WKS_AREAS_NAME).Range(WKS_A3)
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-
-
-        With DstRange
-            .Offset(-2, idx_sCode) = "Common"
-            .Offset(-1, idx_sCode) = "sCode"
-            .Offset(-1, idx_Code) = "Code"
-            .Offset(-1, idx_eDescr) = "Descr_E"
-            .Offset(-1, idx_rDescr) = "Descr_R"
-            .Offset(-2, idx_PriceIN) = "Price (In)"
-            For i = 1 To ListsRange.Count
-                .Offset(-1, i + idx_PriceIN - 1) = ListsRange(i, 1)
-            Next i
-            .Offset(-2, idx_PriceIN + ListsRange.Count) = "Stat of Price (IN)"
-            .Offset(-1, idx_PriceIN + ListsRange.Count) = "Count"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 1) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 1) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 2) = "Max"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 3) = "Avg"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 4) = "Down"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 5) = "Up"
-            .Offset(-2, idx_PriceIN + ListsRange.Count + 6) = "Operators"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 6) = "Price"
-            .Offset(-2, idx_PriceIN + ListsRange.Count + 7) = "Profit[x100%]"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 7) = "Avg"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 8) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 9) = "Max"
-            .Offset(-2, idx_PriceIN + ListsRange.Count + 10) = "Op Profit[x100%] (Routing type 1)"
-            j = idx_PriceIN + ListsRange.Count + 10
-            For i = 1 To ListsRange.Count
-                .Offset(-1, i + j - 1) = ListsRange(i, 1)
-            Next i
-            With .Offset(-2, 0).EntireRow
-                .HorizontalAlignment = xlLeft
-                .Font.Bold = True
-            End With
-            With .Offset(-1, 0).EntireRow
-                .HorizontalAlignment = xlCenter
-                .Font.Bold = True
-            End With
-            
-        End With
-
-' �������� ��������� ������ �� ������� ����
-
-        
-        CopyAreasList DstRange, SrcRange
-        
-        Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-    End With
-
-' ������������ ����� ���������� ���
-
-    Dim AreaCount As Integer
-    AreaCount = GetLinesCount(DstRange)
-
-
-' ����������� ���������� ���������
-        
-    For i = 1 To 4
-        Set DstRange = ThisWorkbook.Worksheets(wks_name) _
-                    .Range(Cells(2, i), Cells(2 + AreaCount, i))
-        With DstRange
-            .EntireColumn.AutoFit
-            If i Mod 2 = 1 Then
-                .Interior.ColorIndex = 36 ' LightYellow
-            Else
-                .Interior.ColorIndex = xlNone  'White
-            End If
-        End With
-    Next i
-
-' ���������� ����/������ ���� ���������� � ��������� ����� ������ ��� �� �����
-' �������� ���� ���������� ��� ���
-
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-    
-        For i = 1 To ListsRange.Count
-            Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-            s = ListsRange.Cells(i, 1).Value
-            If wks_name = WKS_TRAFFIC_NAME Then
-                s = s & ".Data"
-            End If
-            
-            If SheetExist(s) Then
-                Set SrcRange = .Worksheets(s).Range(WKS_A3)
-    
-                AddOpPriceData DstRange, SrcRange, i - 1
-                
-            End If
-            
-' ����������� ���������� ���������
-            With .Worksheets(wks_name)
-                Set DstRange = .Range(.Cells(2, idx_Price + i), .Cells(2 + AreaCount, idx_Price + i))
-            End With
-            With DstRange
-                .NumberFormat = DATA_fmt
-                .Font.Bold = True
-                .HorizontalAlignment = xlCenter
-                .VerticalAlignment = xlBottom
-                .WrapText = False
-                .Orientation = 0
-                .AddIndent = False
-                .ShrinkToFit = False
-                .MergeCells = False
-                If i Mod 2 = 1 Then
-                    .Interior.ColorIndex = 36 ' LightYellow
-                Else
-                    .Interior.ColorIndex = xlNone  'White
-                End If
-            End With
-        Next i
-        With Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, idx_Price + 1), .Cells(2 + AreaCount, idx_Price + ListsRange.Count))
-        End With
-        
-'        DstRange.Select
-        
-        For Each SrcRange In DstRange
-            If SrcRange = "" Then
-                SrcRange = "-"
-            End If
-        Next SrcRange
-        
-        Set SrcRange = .Worksheets(wks_name).Range(WKS_A3)
-    End With
-    
-' ������������ ���������� �� �����
-    Set DstRange = ThisWorkbook.Worksheets(wks_name).Range(WKS_A3).Offset(0, idx_PriceIN + ListsRange.Count)
-    DstRange.Select
-    
-    Dim Stat1stCol As Integer
-    Dim StatMinCol As Integer
-    Dim StatMaxCol As Integer
-    Dim StatAvgCol As Integer
-    Dim StatDnCol As Integer
-    Dim StatUpCol As Integer
-    
-    Dim offsetMinCol As Integer
-    Dim offsetMaxCol As Integer
-    Dim offsetAvgCol As Integer
-    Dim offsetUpCol As Integer
-    Dim offsetDnCol As Integer
-    Dim offsetPriceCol As Integer
-    Dim offsetAvgPtCol As Integer
-    Dim offsetMinPtCol As Integer
-    Dim offsetMaxPtCol As Integer
-    
-    
-    Stat1stCol = idx_PriceIN + ListsRange.Count + 1
-    
-    offsetMinCol = 1
-    offsetMaxCol = 2
-    offsetAvgCol = 3
-    offsetUpCol = 4
-    offsetDnCol = 5
-    offsetPriceCol = 6
-    offsetAvgPtCol = 7
-    offsetMinPtCol = 8
-    offsetMaxPtCol = 9
-    
-    StatMinCol = Stat1stCol + offsetMinCol
-    StatMaxCol = Stat1stCol + offsetMaxCol
-    StatAvgCol = Stat1stCol + offsetAvgCol
-    StatUpCol = Stat1stCol + offsetUpCol
-    StatDnCol = Stat1stCol + offsetDnCol
-    
-    For i = 0 To AreaCount - 1
-        s = RC2ADDR(i + 3, idx_PriceIN + 1) & ":" & RC2ADDR(i + 3, idx_PriceIN + ListsRange.Count)
-        DstRange.Offset(i, 0).Formula = "=count(" & s & ")"
-        
-        Dim AnchorCell As String
-        AnchorCell = RC2ADDR(i + 3, Stat1stCol)
-        
-        DstRange.Offset(i, offsetMinCol).Formula = "=if(" & AnchorCell & ">0, min(" & s & "), ""-"")"
-        DstRange.Offset(i, offsetMaxCol).Formula = "=if(" & AnchorCell & ">0, max(" & s & "), ""-"")"
-        DstRange.Offset(i, offsetAvgCol).Formula = "=if(" & AnchorCell & ">0, average(" & s & "), ""-"")"
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, StatAvgCol) & "-" & RC2ADDR(i + 3, StatMaxCol) & ")/" & RC2ADDR(i + 3, StatAvgCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetDnCol)
-            .Formula = s
-            .NumberFormat = "0.00%_);[Red](0.00)%"
-        End With
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, StatAvgCol) & "-" & RC2ADDR(i + 3, StatMinCol) & ")/" & RC2ADDR(i + 3, StatAvgCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetUpCol)
-            .Formula = s
-            .NumberFormat = "0.00%"
-        End With
-
-' ������ ��������� ���� �� �������.
-        s = "=if(" & AnchorCell & ">0, if(" & RC2ADDR(i + 3, StatAvgCol) & "<=Trigger, " & RC2ADDR(i + 3, StatAvgCol) & "+FixedV," & RC2ADDR(i + 3, StatAvgCol) & "* FIxedP), ""-"")"
-        With DstRange.Offset(i, offsetPriceCol)
-            .Formula = s
-            .NumberFormat = "0.000"
-        End With
-
-' ������ ������� � �������.
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & RC2ADDR(i + 3, StatAvgCol) & ")/" & RC2ADDR(i + 3, StatAvgCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetAvgPtCol)
-            .Formula = s
-            .NumberFormat = "0.00%_);[Red](0.00)%"
-        End With
-
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & RC2ADDR(i + 3, StatMaxCol) & ")/" & RC2ADDR(i + 3, StatMaxCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetMinPtCol)
-            .Formula = s
-            .NumberFormat = "0.00%_);[Red](0.00)%"
-        End With
-
-        s = "=if(" & AnchorCell & ">0, (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & RC2ADDR(i + 3, StatMinCol) & ")/" & RC2ADDR(i + 3, StatMinCol) & ", ""-"")"
-        With DstRange.Offset(i, offsetMaxPtCol)
-            .Formula = s
-            .NumberFormat = "0.00%_);[Red](0.00%)"
-        End With
-
-' ������ ������� � ������� �� ���������� (Routing type 1)
-        
-'        Set ListsRange = ThisWorkbook.Worksheets(WKS_HOME_NAME).Range("OpList")
-
-        For j = 1 To ListsRange.Count
-            AnchorCell = RC2ADDR(i + 3, idx_PriceIN + j)
-            s = "=if(isnumber(" & AnchorCell & "), (" & RC2ADDR(i + 3, Stat1stCol + offsetPriceCol) & "-" & AnchorCell & ")/" & AnchorCell & ", ""-"")"
-            With DstRange.Offset(i, offsetMaxPtCol + j)
-                .Formula = s
-                .NumberFormat = "0.00%_);[Red](0.00)%"
-            End With
-        Next j
-    Next i
-
-
-' ����������� ���������� ���������
-' ����������
-    For i = 0 To 5
-        With ThisWorkbook.Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, Stat1stCol + i), .Cells(2 + AreaCount, Stat1stCol + i))
-        End With
-        With DstRange
-            If i > 0 And i <= 3 Then
-                .NumberFormat = DATA_fmt
-            End If
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-            .WrapText = False
-            .Orientation = 0
-            .AddIndent = False
-            .ShrinkToFit = False
-            .MergeCells = False
-            If i Mod 2 = 0 Then
-                .Interior.ColorIndex = 35 ' LightLightGreen
-            Else
-                .Interior.ColorIndex = 34  ' LightLightBlue
-            End If
-        End With
-    Next i
-
-' ������ ������� "Operators price"
-
-    With ThisWorkbook.Worksheets(wks_name)
-        Set DstRange = .Range(.Cells(2, Stat1stCol + offsetPriceCol), .Cells(2 + AreaCount, Stat1stCol + offsetPriceCol))
-        With DstRange
-            .Interior.ColorIndex = 36 ' LightYellow
-            .Font.ColorIndex = 10
-            .Font.Bold = True
-            .NumberFormat = "0.0000"
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-        End With
-    End With
-
-' ������ ������� � ������� �� ���������� (Routing type 1)
-    For j = 1 To ListsRange.Count
-        With ThisWorkbook.Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, Stat1stCol + offsetMaxPtCol + j), .Cells(2 + AreaCount, Stat1stCol + offsetMaxPtCol + j))
-        End With
-        With DstRange
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-            .WrapText = False
-            .Orientation = 0
-            .AddIndent = False
-            .ShrinkToFit = False
-            .MergeCells = False
-            If j Mod 2 = 0 Then
-                .Interior.ColorIndex = 34  ' LightLightBlue
-            Else
-                .Interior.ColorIndex = 35 ' LightLightGreen
-            End If
-        End With
-    Next j
-    Application.ScreenUpdating = True
-End Sub
-
-Sub CopyAreasList(Dst As Range, Src As Range)
-    While Src <> ""
-        Dst.Offset(0, idx_sCode).Value = Src.Offset(0, idx_sCode).Value
-        Dst.Offset(0, idx_Code).Value = Src.Offset(0, idx_Code).Value
-        Dst.Offset(0, idx_eDescr).Value = Src.Offset(0, idx_eDescr).Value
-        Dst.Offset(0, idx_rDescr).Value = Src.Offset(0, idx_rDescr).Value
-        Set Src = Src.Offset(1, 0)
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-
-Sub AddOpPriceData(Dst As Range, Src As Range, index As Integer)
-    While Src <> ""
-'        If Dst < Src Then
-'            Dst.Offset(0, idx_Price + index) = "-"
-'        End If
-        If Dst = Src Then
-            Dst.Offset(0, idx_Price + index) = Src.Offset(0, idx_Price)
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-'    While Dst <> ""
-'        Dst.Offset(0, idx_Price + index) = "-"
-'        Set Dst = Dst.Offset(1, 0)
-'    Wend
-End Sub
-
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet27
->>>>>>
-Attribute VB_Name = "Sheet27"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-GlobalList
->>>>>>
-Attribute VB_Name = "GlobalList"
-Option Explicit
-
-
-
-Sub Step_2_CreateGlobalCodeList()
-
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-' ������� ���������� ������
-    ClearWorkArea (WKS_AREAS_NAME)
-    
-' ��������� ����� ������ ���
-
-    
-    BuildAreasList (WKS_AREAS_NAME)
-    
-    BuildAreasStatus (WKS_AREAS_NAME)
-
-    
-End Sub
-
-Sub Step_1_BuildWorkPriceLists()
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            CreateComSheet (s)
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            Set SrcRange = .Worksheets(s & ".Tarif").Range(WKS_A3)
-            
-            MarkDublicates SrcRange
-            
-            Set SrcRange = .Worksheets(s & ".Tarif").Range(WKS_A3)
-            AddOpArea DstRange, SrcRange, ADD_CODE_PRICE
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            
-            If SheetExist(s & ".Data") Then
-                Set SrcRange = .Worksheets(s & ".Data").Range(WKS_A3)
-                AddOpArea DstRange, SrcRange, ADD_CODE_TRAFFIC
-            End If
-            
-' ����������� ����� ������:
-' 00 - �� ���������, �� ������������
-' 01 - �� ���������, ������������
-' 10 - ���������, �� ������������
-' 11 - ���������, ������������
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            While DstRange <> ""
-                If DstRange.Offset(0, idx_Price) = 0 Or DstRange.Offset(0, idx_Price) = "-" Then
-                    If DstRange.Offset(0, idx_Traffic) = 0 Then
-                        DstRange.Offset(0, idx_Status) = 0
-                    Else
-                        DstRange.Offset(0, idx_Status) = 1
-                    End If
-                Else
-                    If DstRange.Offset(0, idx_Traffic) = 0 Then
-                        DstRange.Offset(0, idx_Status) = 10
-                    Else
-                        DstRange.Offset(0, idx_Status) = 11
-                    End If
-                End If
-                Set DstRange = DstRange.Offset(1, 0)
-            Wend
-                
-            With .Worksheets(s)
-                With .Columns("A:H")
-                    .HorizontalAlignment = xlHAlignGeneral
-                    .VerticalAlignment = xlBottom
-                    .WrapText = False
-                    .Orientation = 0
-                    .AddIndent = False
-                    .ShrinkToFit = True
-                    .MergeCells = False
-                End With
-                .Columns("A:A").HorizontalAlignment = xlLeft
-                .Columns("B:B").NumberFormat = "#"
-                With .Rows("2:2")
-                    .Font.Bold = False
-                    .WrapText = False
-                    .HorizontalAlignment = xlCenter
-                End With
-                With .Columns("G:G")
-                    .HorizontalAlignment = xlHAlignCenter
-                    .NumberFormat = "0#"
-                End With
-            End With
-            MarkDublicates (.Worksheets(s).Range(WKS_A3))
-        Next i
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-        
-    End With
-
-End Sub
-
-Sub BuildAreasList(DstName As String)
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            If SheetExist(s) Then
-                Set DstRange = .Worksheets(WKS_AREAS_NAME).Range(WKS_A3)
-                Set SrcRange = .Worksheets(s).Range(WKS_A3)
-        
-                AddGlobalOpArea DstRange, SrcRange
-            End If
-        Next i
-        Set SrcRange = .Worksheets(DstName).Range(WKS_A3)
-        .Worksheets(DstName).Select
-                
-        MarkDublicates (.Worksheets(DstName).Range(WKS_A3))
-        
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-    End With
-End Sub
-
-Sub AddGlobalOpArea(Dst As Range, Src As Range)
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst.Offset(0, idx_sCode) = Src.Offset(0, idx_sCode)
-            Dst.Offset(0, idx_Code) = Src.Offset(0, idx_Code)
-        End If
-        If Dst = Src Then
-            CheckNameOpArea Dst, Src, ADD_CODE_ONLY
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    
-    Dst.Worksheet.Columns("A:H").AutoFit
-    
-    Set Dst = Dst.Worksheet.Range(WKS_A3)
-    
-End Sub
-
-Sub CheckNameOpArea(Dst As Range, Src As Range, ByVal add_type As Integer)
-    
-    Dim Exist_SrcEng As Boolean
-    Dim Exist_SrcRus As Boolean
-    Dim Exist_DstEng As Boolean
-    Dim Exist_DstRus As Boolean
-    
-    Dim Unknown_Src As Boolean
-    Dim Unknown_Dst As Boolean
-    
-    With Dst
-        Exist_DstEng = .Offset(0, idx_eDescr) <> "" And .Offset(0, idx_eDescr) <> UNKNOWN_AREA And .Offset(0, idx_eDescr) <> NONAME_AREA
-        Exist_DstRus = .Offset(0, idx_rDescr) <> "" And .Offset(0, idx_rDescr) <> UNKNOWN_AREA And .Offset(0, idx_rDescr) <> NONAME_AREA
-    End With
-    
-    Unknown_Dst = Not (Exist_DstEng Or Exist_DstRus)
-    
-    If add_type = ADD_CODE_TRAFFIC Then
-        If Unknown_Dst Then
-            Dst.Offset(0, idx_eDescr) = UNKNOWN_AREA & Dst.Offset(0, idx_Code)
-            Dst.Offset(0, idx_rDescr) = UNKNOWN_AREA & Dst.Offset(0, idx_Code)
-        End If
-        Exit Sub
-    End If
-    
-    With Src
-        Exist_SrcEng = .Offset(0, idx_eDescr) <> "" And .Offset(0, idx_eDescr) <> UNKNOWN_AREA And .Offset(0, idx_eDescr) <> NONAME_AREA
-        Exist_SrcRus = .Offset(0, idx_rDescr) <> "" And .Offset(0, idx_rDescr) <> UNKNOWN_AREA And .Offset(0, idx_rDescr) <> NONAME_AREA
-    End With
-    
-    Unknown_Src = Not (Exist_SrcEng Or Exist_SrcRus)
-    
-    If Unknown_Src And Unknown_Dst Then
-        Dst.Offset(0, idx_eDescr) = UNKNOWN_AREA
-        Dst.Offset(0, idx_rDescr) = UNKNOWN_AREA
-        Exit Sub
-    End If
-    
-    If Unknown_Src Then
-        If Not Exist_DstRus Then
-            Dst.Offset(0, idx_rDescr) = NONAME_AREA
-        End If
-        If Not Exist_DstEng Then
-            Dst.Offset(0, idx_eDescr) = NONAME_AREA
-        End If
-    Else
-        If Not Exist_DstEng Then
-            If Exist_SrcEng Then
-                Dst.Offset(0, idx_eDescr) = Src.Offset(0, idx_eDescr)
-            Else
-                Dst.Offset(0, idx_eDescr) = NONAME_AREA
-            End If
-        End If
-        If Not Exist_DstRus Then
-            If Exist_SrcRus Then
-                Dst.Offset(0, idx_rDescr) = Src.Offset(0, idx_rDescr)
-            Else
-                Dst.Offset(0, idx_rDescr) = NONAME_AREA
-            End If
-        End If
-    End If
-End Sub
-
-Sub AddOpArea(Dst As Range, Src As Range, Optional add_type = ADD_CODE_ONLY)
-    
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst.Offset(0, idx_sCode) = Src.Offset(0, idx_sCode)
-            Dst.Offset(0, idx_Code) = Src.Offset(0, idx_Code)
-        End If
-        If Dst = Src Then
-            Select Case add_type
-                Case ADD_CODE_PRICE
-                    Dst.Offset(0, idx_Price) = Src.Offset(0, idx_Price)
-                    If Dst.Offset(0, idx_Price) = "" Then
-                        Dst.Offset(0, idx_Price) = "-"
-                    End If
-                Case ADD_CODE_TRAFFIC
-                    Dst.Offset(0, idx_Traffic) = Src.Offset(0, idx_DatTraffic)
-            End Select
-            
-            CheckNameOpArea Dst, Src, add_type
-                        
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    
-    Select Case add_type
-        Case ADD_CODE_PRICE
-            Dst.Worksheet.Columns("E:E").NumberFormat = "0.0000"
-        Case ADD_CODE_TRAFFIC
-            Dst.Worksheet.Columns("F:F").NumberFormat = "0.00"
-    End Select
-    
-    Dst.Worksheet.Columns("A:H").AutoFit
-    
-    Set Dst = Dst.Worksheet.Range("A1")
-End Sub
-
-Sub BuildAreasStatus(wks_name As String)
-    Dim rSrc As Range
-    Dim rDst As Range
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim j As Integer
-    Dim s As String
-    Dim WS_Name As String
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        
-' ��������� ������ ������
-
-        Dim AreaCount As Integer
-
-        Set rDst = .Worksheets(wks_name).Range(WKS_A3)
-        
-        AreaCount = GetLinesCount(rDst) + 3
-
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        Set rDst = .Worksheets(wks_name).Range(WKS_A3)
-        j = 3
-        
-        For i = 1 To ListsRange.Count
-            rDst.Offset(-1, i + idx_GLStatus).Formula = ListsRange(i, 1)
-        Next i
-        
-' ��������� ������� ��� ��� ������ ����������
-        While rDst <> ""
-            For i = 1 To ListsRange.Count
-                WS_Name = ListsRange(i, 1)
-                If SheetExist(WS_Name) Then
-                    s = "INDEX(" & WS_Name & "!G1:$G$" & AreaCount & ", MATCH($A" & j & "," & WS_Name & "!$A$1:$A$" & AreaCount & ",0), 1)"
-                    s = "=if(iserror(" & s & "), ""-""," & s & ")"
-                Else
-                    s = "-"
-                End If
-                rDst.Offset(0, i + idx_GLStatus).Formula = s
-                rDst.Offset(0, i + idx_GLStatus).NumberFormat = "0#"
-            Next i
-            j = j + 1
-            Set rDst = rDst.Offset(1, 0)
-        Wend
-        
-' ����������� ���������
-        For i = 0 To ListsRange.Count
-            With rDst.Offset(-1, i + idx_GLStatus).EntireColumn
-                .HorizontalAlignment = xlCenter
-                .ShrinkToFit = True
-            End With
-        Next i
-
-' ������������ �������� ���
-
-        With .Worksheets(wks_name)
-            Set rDst = .Range(.Cells(3, 1), .Cells(AreaCount, 1))
-        End With
-
-        Set rSrc = .Worksheets(WKS_FIX_AREAS_NAME).Range(WKS_A3)
-        
-        AreaCount = GetLinesCount(rSrc) + 3
-
-        With .Worksheets(WKS_FIX_AREAS_NAME)
-            Set rSrc = .Range(.Cells(2, 1), .Cells(AreaCount, 1))
-        End With
-
-        Dim b As Range
-        Dim c As Range
-        For Each c In rDst
-            Set b = rSrc.Find(c, LookIn:=xlValues, MatchByte:=True)
-            If Not b Is Nothing Then
-                If c.Offset(0, idx_eDescr) <> b.Offset(0, idx_eDescr) Or c.Offset(0, idx_rDescr) <> b.Offset(0, idx_rDescr) Then
-                    c.Offset(0, idx_eDescr) = b.Offset(0, idx_eDescr)
-                    c.Offset(0, idx_rDescr) = b.Offset(0, idx_rDescr)
-                    c.Offset(0, idx_GLStatus) = "Fixed"
-                    With c.EntireRow
-                        .Font.Bold = True
-                        .Font.ColorIndex = xlColorIndexAutomatic
-                    End With
-                Else
-                    c.Offset(0, idx_GLStatus) = "-"
-                End If
-            Else
-                If c.Offset(0, idx_sCode) <> "" Then
-                    Dim FixedList As Range
-                    c.Offset(0, idx_GLStatus) = "New"
-                    With c.EntireRow
-                        .Font.Bold = True
-                        .Font.ColorIndex = 3 ' Red
-                    End With
-                End If
-                
-'                Set Fixed
-            End If
-        Next c
-        
-        Application.ScreenUpdating = True
-        
-    End With
-End Sub
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Sub ClearWorkArea(DstName As String)
-    Dim DstRange As Range
-    With ThisWorkbook
-       
-        Set DstRange = .Worksheets(DstName).Range(WKS_A3)
-        Worksheets(DstName).Select
-        DstRange.Select
-        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
-        Range(Selection, Selection.End(xlDown)).Select
-        Selection.Delete Shift:=xlUp
-        Selection.Font.Bold = False
-        Selection.Font.ColorIndex = xlColorIndexAutomatic
-        Set DstRange = .Worksheets(DstName).Range(WKS_A3)
-        DstRange.Select
-    End With
-End Sub
-
-Function SheetExist(SheetName As String) As Boolean
-    Dim Count, i As Integer
-
-    Count = ThisWorkbook.Sheets.Count
-    SheetExist = False
-    For i = 1 To Count
-        If ThisWorkbook.Sheets(i).Name = SheetName Then
-            SheetExist = True
-            i = Count
-        End If
-    Next i
-End Function
-
-Function GetLinesCount(r As Range) As Integer
-
-    Dim LinesCount As Integer
-    LinesCount = 0
-
-    While r <> ""
-        LinesCount = LinesCount + 1
-        Set r = r.Offset(1, 0)
-    Wend
-    
-    GetLinesCount = LinesCount
-End Function
-
-Sub CreateComSheet(wks_name As String)
-    Dim theRange As Range
-    With ThisWorkbook
-        If Not SheetExist(wks_name) Then
-            .Sheets.Add.Name = wks_name
-        End If
-            
-        .Sheets(wks_name).Visible = True
-        .Sheets(wks_name).Select
-        Cells.Select
-        Selection.ClearContents
-        Selection.Interior.ColorIndex = xlNone
-        Selection.Borders(xlLeft).LineStyle = xlNone
-        Selection.Borders(xlRight).LineStyle = xlNone
-        Selection.Borders(xlTop).LineStyle = xlNone
-        Selection.Borders(xlBottom).LineStyle = xlNone
-        Selection.BorderAround LineStyle:=xlNone
-        Selection.Font.ColorIndex = 0
-        Selection.EntireColumn.ColumnWidth = ActiveSheet.StandardWidth
-    
-        With .Worksheets(wks_name)
-            .Range("a1") = wks_name
-            With .Range("a2")
-                .Offset(0, idx_sCode) = "sCode"
-                .Offset(0, idx_Code) = "Code"
-                .Offset(0, idx_eDescr) = "Descr_E"
-                .Offset(0, idx_rDescr) = "Descr_R"
-                .Offset(0, idx_Price) = "Price"
-                .Offset(0, idx_Traffic) = "Traffic"
-                .Offset(0, idx_Status) = "Status"
-                .Offset(0, idx_Price2) = "Price2"
-            End With
-            With .Rows("2:2")
-                .Font.Bold = False
-                .WrapText = False
-                .HorizontalAlignment = xlCenter
-            End With
-            .Range("A1").Select
-        End With
-    End With
-End Sub
-
-Function GetGlobalAreaIdx(wks_name As String, range_name As String, AreaCount As Integer, scDst) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim Answer As Integer
-    
-    GetGlobalAreaIdx = -1
-    
-    With ThisWorkbook.Worksheets(wks_name)
-        For i = Len(scDst) To 2 Step -1
-            s = Left(scDst, i)
-            Answer = FindVIndex(.Range(range_name), AreaCount, s)
-            If Answer > 0 Then
-                GetGlobalAreaIdx = Answer
-                Exit Function
-            End If
-        Next i
-    End With
-End Function
-
-Function FindVIndex(Src As Range, AreaCount As Integer, s As String, Optional Start As Integer = 1) As Integer
-    Dim l As Long
-    FindVIndex = -1
-    For l = Start To AreaCount
-        If s = Src.Cells(l, 1) Then
-            FindVIndex = l
-            Exit Function
-        End If
-    Next l
-End Function
-
-Sub MarkDublicates(Src As Range)
-    Dim Dst As Range
-    Set Dst = Src.Offset(1, 0)
-    While Dst <> ""
-        If Dst = Src Then
-            With Dst.EntireRow
-                .Font.Bold = True
-                .Font.ColorIndex = 3
-            End With
-            Set Dst = Dst.Offset(1, 0)
-        Else
-            Set Src = Dst
-            Set Dst = Src.Offset(1, 0)
-        End If
-    Wend
-End Sub
-
-Function RC2ADDR(RowIdx As Integer, ColIdx As Integer) As String
-    Dim s As String
-    Dim Chars As String
-    Dim Idx As Integer
-    Idx = ColIdx
-    Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-    While Idx > 1
-        s = Mid(Chars, Idx Mod Len(Chars), 1) & s
-        Idx = Idx \ Len(Chars)
-    Wend
-    RC2ADDR = s & RowIdx
-End Function
-<<<<<<
-======================
-Constatnts
->>>>>>
-Attribute VB_Name = "Constatnts"
-Option Explicit
-
-Public Const UNKNOWN_AREA As String = "UNKNOWN_"
-Public Const NONAME_AREA As String = "*"
-
-Public Const WKS_AREAS_NAME As String = "GlobalList"
-Public Const WKS_PRICE_NAME As String = "OpPrices"
-Public Const WKS_COMPACT_NAME As String = "CompactPrices"
-Public Const WKS_TRAFFIC_NAME As String = "OpTraffic"
-Public Const WKS_FIX_AREAS_NAME As String = "GLFixed"
-Public Const WKS_HOME_NAME As String = "Home"
-
-Public Const WKS_A3 As String = "A3"
-Public Const idx_sCode As Integer = 0
-Public Const idx_Code As Integer = 1
-Public Const idx_eDescr As Integer = 2
-Public Const idx_rDescr As Integer = 3
-Public Const idx_Price As Integer = 4
-Public Const idx_Traffic As Integer = 5
-Public Const idx_Status As Integer = 6
-Public Const idx_Price2 As Integer = 7
-
-Public Const idx_DatTraffic As Integer = 2
-Public Const idx_GLStatus As Integer = 4
-
-Public Const ADD_CODE_ONLY As Integer = 0
-Public Const ADD_CODE_PRICE As Integer = 1
-Public Const ADD_CODE_TRAFFIC As Integer = 2
-
-
-
-
-Sub Step_3_Recalc_1st_Prices()
-    AnalyzeOpPricesData WKS_PRICE_NAME, "0.0000"
-End Sub
-
-Sub Step_5_Compact_1st_Prices()
-    CompactOpPricesData WKS_COMPACT_NAME
-End Sub
-
-Sub AnalyzeData()
-'    AnalyzeOpPricesData WKS_TRAFFIC_NAME, "0."
-    MsgBox "This code not debuged"
-End Sub
-
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet28
->>>>>>
-Attribute VB_Name = "Sheet28"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet29
->>>>>>
-Attribute VB_Name = "Sheet29"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mCompact
->>>>>>
-Attribute VB_Name = "mCompact"
-Option Explicit
-
-Sub CompactOpPricesData(wks_name As String)
-
-' ��������� ������ ��� �� ������� �����
-' ������� ���������� ������
-    ClearWorkArea (wks_name)
-    
-    ThisWorkbook.Worksheets(wks_name).Activate
-    ThisWorkbook.Worksheets(wks_name).Cells.Select
-    With Selection
-        .ClearContents
-        .Interior.ColorIndex = xlNone
-        .Font.Bold = False
-        .Font.ColorIndex = 0
-        .HorizontalAlignment = xlGeneral
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-        .Orientation = 0
-        .AddIndent = False
-        .ShrinkToFit = False
-        .MergeCells = False
-    End With
-    ThisWorkbook.Worksheets(wks_name).Range("A1").Select
-' ����������� ��������� �������� �����
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim j As Integer
-
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-        Set SrcRange = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3)
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-
-
-        With DstRange
-            .Offset(-2, idx_sCode) = "Compact"
-            .Offset(-1, idx_sCode) = "sCode"
-            .Offset(-1, idx_Code) = "Code"
-            .Offset(-1, idx_eDescr) = "Descr_E"
-            .Offset(-1, idx_rDescr) = "Descr_R"
-            .Offset(-2, idx_PriceIN) = "Price (In)"
-            For i = 1 To ListsRange.Count
-                .Offset(-1, i + idx_PriceIN - 1) = ListsRange(i, 1)
-            Next i
-            .Offset(-2, idx_PriceIN + ListsRange.Count) = "Stat of Price (IN)"
-            .Offset(-1, idx_PriceIN + ListsRange.Count) = "Count"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 1) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 1) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 2) = "Max"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 3) = "Avg"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 4) = "Down"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 5) = "Up"
-            .Offset(-2, idx_PriceIN + ListsRange.Count + 6) = "Operators"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 6) = "Price"
-            .Offset(-2, idx_PriceIN + ListsRange.Count + 7) = "Profit[x100%]"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 7) = "Avg"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 8) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 9) = "Max"
-            .Offset(-2, idx_PriceIN + ListsRange.Count + 10) = "Op Profit[x100%] (Routing type 1)"
-            j = idx_PriceIN + ListsRange.Count + 10
-            For i = 1 To ListsRange.Count
-                .Offset(-1, i + j - 1) = ListsRange(i, 1)
-            Next i
-            With .Offset(-2, 0).EntireRow
-                .HorizontalAlignment = xlLeft
-                .Font.Bold = True
-            End With
-            With .Offset(-1, 0).EntireRow
-                .HorizontalAlignment = xlCenter
-                .Font.Bold = True
-            End With
-            
-        End With
-
-' �������� ��������� ������ �� ������� ����
-
-        
-        CopyCompactAreasList DstRange, SrcRange
-        
-        
-        For i = 0 To ListsRange.Count - 1
-            Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-            Set SrcRange = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3)
-            AddCompactOpPriceData DstRange, SrcRange, i
-        Next i
-        
-        Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-    End With
-End Sub
-
-Sub CopyCompactAreasList(Dst As Range, Src As Range)
-    Dim s As String
-    Dim Idx As Integer
-    Dim AreaCount As Integer
-    Dim r As Range
-    
-    Set r = Src
-    
-    AreaCount = GetLinesCount(r)
-    
-    While Src <> ""
-        s = Src.Offset(0, idx_eDescr).Value
-        Idx = FindVIndex(Dst.Worksheet.Range("C:C"), AreaCount, s, 1)
-        If Idx = -1 Then
-            Dst.Offset(0, idx_sCode).Value = "-"
-            Dst.Offset(0, idx_Code).Value = "-"
-            Dst.Offset(0, idx_eDescr).Value = Src.Offset(0, idx_eDescr).Value
-            Dst.Offset(0, idx_rDescr).Value = Src.Offset(0, idx_rDescr).Value
-            Set Dst = Dst.Offset(1, 0)
-        End If
-        Set Src = Src.Offset(1, 0)
-    Wend
-End Sub
-
-Sub AddCompactOpPriceData(Dst As Range, Src As Range, index As Integer)
-    Dim Idx As Integer
-    Dim Val As Variant
-    Dim scSrc As Range
-        
-Set scSrc = Src
-    
-    While Dst.Offset(0, idx_eDescr) <> ""
-        Do While scSrc <> ""
-            If Dst.Offset(0, idx_eDescr) = scSrc.Offset(0, idx_eDescr) Then
-                Val = scSrc.Offset(0, idx_Price + index)
-                If Application.WorksheetFunction.IsNumber(Val) Then
-                    Dst.Offset(0, idx_Price + index) = Val
-                    Exit Do
-                Else
-                    Set scSrc = scSrc.Offset(1, 0)
-                End If
-            Else
-                Set scSrc = scSrc.Offset(1, 0)
-            End If
-        Loop
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-Type PriceRecord
-    Aria As String
-    Description As String
-    Description2 As String
-    Price As Double
-End Type
-
-Dim SourcePrData() As PriceRecord
-
-Sub a()
-    ReDim SourcePrData(1 To 5)
-    Erase SourcePrData
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet37
->>>>>>
-Attribute VB_Name = "Sheet37"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-mAnalisys
->>>>>>
-Attribute VB_Name = "mAnalisys"
-Option Explicit
-
-Public Const idx_PriceIN As Integer = 4
-
-
-Sub AnalyzeOpPricesData(wks_name As String, DATA_fmt As String)
-
-' ��������� ������ ��� �� ������� �����
-' ������� ���������� ������
-    ClearWorkArea (wks_name)
-
-' ����������� ��������� �������� �����
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim j As Integer
-
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-        Set SrcRange = .Worksheets(WKS_AREAS_NAME).Range(WKS_A3)
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-
-
-        With DstRange
-            .Offset(-2, idx_sCode) = "Common"
-            .Offset(-1, idx_sCode) = "sCode"
-            .Offset(-1, idx_Code) = "Code"
-            .Offset(-1, idx_eDescr) = "Descr_E"
-            .Offset(-1, idx_rDescr) = "Descr_R"
-            .Offset(-2, idx_PriceIN) = "Price (In)"
-            For i = 1 To ListsRange.Count
-                .Offset(-1, i + idx_PriceIN - 1) = ListsRange(i, 1)
-            Next i
-            .Offset(-2, idx_PriceIN + ListsRange.Count) = "Stat of Price (IN)"
-            .Offset(-1, idx_PriceIN + ListsRange.Count) = "Count"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 1) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 1) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 2) = "Max"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 3) = "Avg"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 4) = "Down"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 5) = "Up"
-            .Offset(-2, idx_PriceIN + ListsRange.Count + 6) = "Operators"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 6) = "Price"
-            .Offset(-2, idx_PriceIN + ListsRange.Count + 7) = "Profit[x100%]"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 7) = "Avg"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 8) = "Min"
-            .Offset(-1, idx_PriceIN + ListsRange.Count + 9) = "Max"
-            .Offset(-2, idx_PriceIN + ListsRange.Count + 10) = "Op Profit[x100%] (Ruting type 1)"
-            j = idx_PriceIN + ListsRange.Count + 10
-            For i = 1 To ListsRange.Count
-                .Offset(-1, i + j - 1) = ListsRange(i, 1)
-            Next i
-            With .Offset(-2, 0).EntireRow
-                .HorizontalAlignment = xlLeft
-                .Font.Bold = True
-            End With
-            With .Offset(-1, 0).EntireRow
-                .HorizontalAlignment = xlCenter
-                .Font.Bold = True
-            End With
-            
-        End With
-
-' �������� ��������� ������ �� ������� ����
-
-        
-        CopyAreasList DstRange, SrcRange
-        
-        Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-    End With
-
-' ������������ ����� ���������� ���
-
-    Dim AreaCount As Integer
-    AreaCount = GetLinesCount(DstRange)
-
-
-' ����������� ���������� ���������
-        
-    For i = 1 To 4
-        Set DstRange = ThisWorkbook.Worksheets(wks_name) _
-                    .Range(Cells(2, i), Cells(2 + AreaCount, i))
-        With DstRange
-            .EntireColumn.AutoFit
-            If i Mod 2 = 1 Then
-                .Interior.ColorIndex = 36 ' LightYellow
-            Else
-                .Interior.ColorIndex = xlNone  'White
-            End If
-        End With
-    Next i
-
-' ���������� ����/������ ���� ���������� � ��������� ����� ������ ��� �� �����
-' �������� ���� ���������� ��� ���
-
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-    
-        For i = 1 To ListsRange.Count
-            Set DstRange = .Worksheets(wks_name).Range(WKS_A3)
-            s = ListsRange.Cells(i, 1).Value
-            If wks_name = WKS_TRAFFIC_NAME Then
-                s = s & ".Data"
-            End If
-            
-            If SheetExist(s) Then
-                Set SrcRange = .Worksheets(s).Range(WKS_A3)
-    
-                AddOpPriceData DstRange, SrcRange, i - 1
-                
-            End If
-            
-' ����������� ���������� ���������
-            With .Worksheets(wks_name)
-                Set DstRange = .Range(.Cells(2, idx_Price + i), .Cells(2 + AreaCount, idx_Price + i))
-            End With
-            With DstRange
-                .NumberFormat = DATA_fmt
-                .Font.Bold = True
-                .HorizontalAlignment = xlCenter
-                .VerticalAlignment = xlBottom
-                .WrapText = False
-                .Orientation = 0
-                .AddIndent = False
-                .ShrinkToFit = False
-                .MergeCells = False
-                If i Mod 2 = 1 Then
-                    .Interior.ColorIndex = 36 ' LightYellow
-                Else
-                    .Interior.ColorIndex = xlNone  'White
-                End If
-            End With
-        Next i
-        With Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, idx_Price + 1), .Cells(2 + AreaCount, idx_Price + ListsRange.Count))
-        End With
-        
-'        DstRange.Select
-        
-        For Each SrcRange In DstRange
-            If SrcRange = "" Then
-                SrcRange = "-"
-            End If
-        Next SrcRange
-        
-        Set SrcRange = .Worksheets(wks_name).Range(WKS_A3)
-    End With
-    
-'' ������������ ���������� �� �����
-'    Set DstRange = ThisWorkbook.Worksheets(wks_name).Range(WKS_A3).Offset(0, idx_PriceIN + ListsRange.Count)
-'    DstRange.Select
-'
-'    DstRange.Column
-'
-'    For i = 0 To AreaCount - 1
-'        s = "(E" & i + 3 & ":K" & i + 3 & ")"
-'        DstRange.Offset(i, 0).Formula = "=count" + s
-'        DstRange.Offset(i, 1).Formula = "=if(L" & i + 3 & ">0, min" & s & ", ""-"")"
-'        DstRange.Offset(i, 2).Formula = "=if(L" & i + 3 & ">0, max" & s & ", ""-"")"
-'        DstRange.Offset(i, 3).Formula = "=if(L" & i + 3 & ">0, average" & s & ", ""-"")"
-'        s = "=if(L" & (i + 3) & ">0, (O" & (i + 3) & "-M" & (i + 3) & ")/O" & (i + 3) & ", ""-"")"
-'        With DstRange.Offset(i, 4)
-'            .Formula = s
-'            .NumberFormat = "0.00%"
-'        End With
-'        s = "=if(L" & i + 3 & ">0, (N" & (i + 3) & "-O" & (i + 3) & ")/O" & (i + 3) & ", ""-"")"
-'        With DstRange.Offset(i, 5)
-'            .Formula = s
-'            .NumberFormat = "0.00%"
-'        End With
-'
-'' ������ ��������� ���� �� �������.
-'        s = "=if(L" & i + 3 & ">0, if(O" & (i + 3) & "<=Trigger, O" & (i + 3) & "+FixedV, O" & (i + 3) & "* FIxedP), ""-"")"
-'        With DstRange.Offset(i, 6)
-'            .Formula = s
-'        End With
-'
-'' ������ ������� � �������.
-'        s = "=if(isnumber(R" & i + 3 & "), (R" & (i + 3) & "- O" & (i + 3) & ")/ O" & (i + 3) & ", ""-"")"
-'        With DstRange.Offset(i, 7)
-'            .Formula = s
-'            .NumberFormat = "0.00%_);[Red](0.00%)"
-'        End With
-'
-'        s = "=if(isnumber(R" & i + 3 & "), (R" & (i + 3) & "- N" & (i + 3) & ")/ N" & (i + 3) & ", ""-"")"
-'        With DstRange.Offset(i, 8)
-'            .Formula = s
-'            .NumberFormat = "0.00%_);[Red](0.00%)"
-'        End With
-'
-'        s = "=if(isnumber(R" & i + 3 & "), (R" & (i + 3) & "- M" & (i + 3) & ")/ M" & (i + 3) & ", ""-"")"
-'        With DstRange.Offset(i, 9)
-'            .Formula = s
-'            .NumberFormat = "0.00%_);[Red](0.00%)"
-'        End With
-'
-'' ������ ������� � ������� �� ����������
-'
-'    Next i
-'
-'
-'' ����������� ���������� ���������
-'' ����������
-'    For i = 0 To 5
-'        With ThisWorkbook.Worksheets(wks_name)
-'            Set DstRange = .Range(.Cells(2, idx_Price + ListsRange.Count + 1 + i), .Cells(2 + AreaCount, idx_Price + ListsRange.Count + 1 + i))
-'        End With
-'        With DstRange
-'            If i <> 0 Then
-'                .NumberFormat = DATA_fmt
-'            End If
-'            .HorizontalAlignment = xlCenter
-'            .VerticalAlignment = xlBottom
-'            .WrapText = False
-'            .Orientation = 0
-'            .AddIndent = False
-'            .ShrinkToFit = False
-'            .MergeCells = False
-'            If i Mod 2 = 0 Then
-'                .Interior.ColorIndex = 35 ' LightLightGreen
-'            Else
-'                .Interior.ColorIndex = 34  ' LightLightBlue
-'            End If
-'            .Application.ScreenUpdating = True
-'
-'        End With
-'    Next i
-'
-'' ������ ������� "Operators price"
-'
-'    With ThisWorkbook.Worksheets(wks_name)
-'        Set DstRange = .Range(.Cells(2, idx_Price + ListsRange.Count + 7), .Cells(2 + AreaCount, idx_Price + ListsRange.Count + 7))
-'        DstRange.Interior.ColorIndex = 36 ' LightYellow
-'        DstRange.Font.ColorIndex = 10
-'        DstRange.Font.Bold = True
-'        DstRange.NumberFormat = "0.0000"
-'    End With
-'
-'' �������/������
-'    For i = 0 To 2
-'        With ThisWorkbook.Worksheets(wks_name)
-'            Set DstRange = .Range(.Cells(2, idx_Price + ListsRange.Count + 8 + i), .Cells(2 + AreaCount, idx_Price + ListsRange.Count + 8 + i))
-'        End With
-'        With DstRange
-'            .HorizontalAlignment = xlCenter
-'            .VerticalAlignment = xlBottom
-'            .WrapText = False
-'            .Orientation = 0
-'            .AddIndent = False
-'            .ShrinkToFit = False
-'            .MergeCells = False
-'            If i Mod 2 = 0 Then
-'                .Interior.ColorIndex = 34  ' LightLightBlue
-'            Else
-'                .Interior.ColorIndex = 35 ' LightLightGreen
-'            End If
-'            .Application.ScreenUpdating = True
-'
-'        End With
-'    Next i
-End Sub
-
-Sub CopyAreasList(Dst As Range, Src As Range)
-    While Src <> ""
-        Dst.Offset(0, idx_sCode).Value = Src.Offset(0, idx_sCode).Value
-        Dst.Offset(0, idx_Code).Value = Src.Offset(0, idx_Code).Value
-        Dst.Offset(0, idx_eDescr).Value = Src.Offset(0, idx_eDescr).Value
-        Dst.Offset(0, idx_rDescr).Value = Src.Offset(0, idx_rDescr).Value
-        Set Src = Src.Offset(1, 0)
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-
-Sub AddOpPriceData(Dst As Range, Src As Range, index As Integer)
-    While Src <> ""
-'        If Dst < Src Then
-'            Dst.Offset(0, idx_Price + index) = "-"
-'        End If
-        If Dst = Src Then
-            Dst.Offset(0, idx_Price + index) = Src.Offset(0, idx_Price)
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-'    While Dst <> ""
-'        Dst.Offset(0, idx_Price + index) = "-"
-'        Set Dst = Dst.Offset(1, 0)
-'    Wend
-End Sub
-
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet36
->>>>>>
-Attribute VB_Name = "Sheet36"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-GlobalList
->>>>>>
-Attribute VB_Name = "GlobalList"
-Option Explicit
-
-
-
-Sub CreateGlobalCodeList()
-
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-' ������� ���������� ������
-    ClearWorkArea (WKS_AREAS_NAME)
-    
-' ��������� ����� ������ ���
-
-    BuildAreasList (WKS_AREAS_NAME)
-    
-    BuildAreasStatus (WKS_AREAS_NAME)
-
-End Sub
-
-Sub BuildWorkPriceLists()
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            CreateComSheet (s)
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            Set SrcRange = .Worksheets(s & ".Tarif").Range(WKS_A3)
-            
-            MarkDublicates SrcRange
-            
-            Set SrcRange = .Worksheets(s & ".Tarif").Range(WKS_A3)
-            AddOpArea DstRange, SrcRange, ADD_CODE_PRICE
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            
-            If SheetExist(s & ".Data") Then
-                Set SrcRange = .Worksheets(s & ".Data").Range(WKS_A3)
-                AddOpArea DstRange, SrcRange, ADD_CODE_TRAFFIC
-            End If
-            
-' ����������� ����� ������:
-' 00 - �� ���������, �� ������������
-' 01 - �� ���������, ������������
-' 10 - ���������, �� ������������
-' 11 - ���������, ������������
-            
-            Set DstRange = .Worksheets(s).Range(WKS_A3)
-            While DstRange <> ""
-                If DstRange.Offset(0, idx_Price) = 0 Or DstRange.Offset(0, idx_Price) = "-" Then
-                    If DstRange.Offset(0, idx_Traffic) = 0 Then
-                        DstRange.Offset(0, idx_Status) = 0
-                    Else
-                        DstRange.Offset(0, idx_Status) = 1
-                    End If
-                Else
-                    If DstRange.Offset(0, idx_Traffic) = 0 Then
-                        DstRange.Offset(0, idx_Status) = 10
-                    Else
-                        DstRange.Offset(0, idx_Status) = 11
-                    End If
-                End If
-                Set DstRange = DstRange.Offset(1, 0)
-            Wend
-                
-            With .Worksheets(s)
-                With .Columns("A:H")
-                    .HorizontalAlignment = xlHAlignGeneral
-                    .VerticalAlignment = xlBottom
-                    .WrapText = False
-                    .Orientation = 0
-                    .AddIndent = False
-                    .ShrinkToFit = True
-                    .MergeCells = False
-                End With
-                .Columns("A:A").HorizontalAlignment = xlLeft
-                .Columns("B:B").NumberFormat = "#"
-                With .Rows("2:2")
-                    .Font.Bold = False
-                    .WrapText = False
-                    .HorizontalAlignment = xlCenter
-                End With
-                With .Columns("G:G")
-                    .HorizontalAlignment = xlHAlignCenter
-                    .NumberFormat = "0#"
-                End With
-            End With
-            MarkDublicates (.Worksheets(s).Range(WKS_A3))
-        Next i
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-    End With
-
-End Sub
-
-Sub BuildAreasList(DstName As String)
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            Set DstRange = .Worksheets(WKS_AREAS_NAME).Range(WKS_A3)
-            Set SrcRange = .Worksheets(s).Range(WKS_A3)
-        
-            AddGlobalOpArea DstRange, SrcRange
-        Next i
-        Set SrcRange = .Worksheets(DstName).Range(WKS_A3)
-        .Worksheets(DstName).Select
-                
-        MarkDublicates (.Worksheets(DstName).Range(WKS_A3))
-        
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-    End With
-End Sub
-
-Sub AddGlobalOpArea(Dst As Range, Src As Range)
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst.Offset(0, idx_sCode) = Src.Offset(0, idx_sCode)
-            Dst.Offset(0, idx_Code) = Src.Offset(0, idx_Code)
-        End If
-        If Dst = Src Then
-            CheckNameOpArea Dst, Src, ADD_CODE_ONLY
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    
-    Dst.Worksheet.Columns("A:H").AutoFit
-    
-    Set Dst = Dst.Worksheet.Range(WKS_A3)
-    
-End Sub
-
-Sub CheckNameOpArea(Dst As Range, Src As Range, ByVal add_type As Integer)
-    
-    Dim Exist_SrcEng As Boolean
-    Dim Exist_SrcRus As Boolean
-    Dim Exist_DstEng As Boolean
-    Dim Exist_DstRus As Boolean
-    
-    Dim Unknown_Src As Boolean
-    Dim Unknown_Dst As Boolean
-    
-    With Dst
-        Exist_DstEng = .Offset(0, idx_eDescr) <> "" And .Offset(0, idx_eDescr) <> UNKNOWN_AREA And .Offset(0, idx_eDescr) <> NONAME_AREA
-        Exist_DstRus = .Offset(0, idx_rDescr) <> "" And .Offset(0, idx_rDescr) <> UNKNOWN_AREA And .Offset(0, idx_rDescr) <> NONAME_AREA
-    End With
-    
-    Unknown_Dst = Not (Exist_DstEng Or Exist_DstRus)
-    
-    If add_type = ADD_CODE_TRAFFIC Then
-        If Unknown_Dst Then
-            Dst.Offset(0, idx_eDescr) = UNKNOWN_AREA
-            Dst.Offset(0, idx_rDescr) = UNKNOWN_AREA
-        End If
-        Exit Sub
-    End If
-    
-    With Src
-        Exist_SrcEng = .Offset(0, idx_eDescr) <> "" And .Offset(0, idx_eDescr) <> UNKNOWN_AREA And .Offset(0, idx_eDescr) <> NONAME_AREA
-        Exist_SrcRus = .Offset(0, idx_rDescr) <> "" And .Offset(0, idx_rDescr) <> UNKNOWN_AREA And .Offset(0, idx_rDescr) <> NONAME_AREA
-    End With
-    
-    Unknown_Src = Not (Exist_SrcEng Or Exist_SrcRus)
-    
-    If Unknown_Src And Unknown_Dst Then
-        Dst.Offset(0, idx_eDescr) = UNKNOWN_AREA
-        Dst.Offset(0, idx_rDescr) = UNKNOWN_AREA
-        Exit Sub
-    End If
-    
-    If Unknown_Src Then
-        If Not Exist_DstRus Then
-            Dst.Offset(0, idx_rDescr) = NONAME_AREA
-        End If
-        If Not Exist_DstEng Then
-            Dst.Offset(0, idx_eDescr) = NONAME_AREA
-        End If
-    Else
-        If Not Exist_DstEng Then
-            If Exist_SrcEng Then
-                Dst.Offset(0, idx_eDescr) = Src.Offset(0, idx_eDescr)
-            Else
-                Dst.Offset(0, idx_eDescr) = NONAME_AREA
-            End If
-        End If
-        If Not Exist_DstRus Then
-            If Exist_SrcRus Then
-                Dst.Offset(0, idx_rDescr) = Src.Offset(0, idx_rDescr)
-            Else
-                Dst.Offset(0, idx_rDescr) = NONAME_AREA
-            End If
-        End If
-    End If
-End Sub
-
-Sub AddOpArea(Dst As Range, Src As Range, Optional add_type = ADD_CODE_ONLY)
-    
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst.Offset(0, idx_sCode) = Src.Offset(0, idx_sCode)
-            Dst.Offset(0, idx_Code) = Src.Offset(0, idx_Code)
-        End If
-        If Dst = Src Then
-            Select Case add_type
-                Case ADD_CODE_PRICE
-                    Dst.Offset(0, idx_Price) = Src.Offset(0, idx_Price)
-                    If Dst.Offset(0, idx_Price) = "" Then
-                        Dst.Offset(0, idx_Price) = "-"
-                    End If
-                Case ADD_CODE_TRAFFIC
-                    Dst.Offset(0, idx_Traffic) = Src.Offset(0, idx_DatTraffic)
-            End Select
-            
-            CheckNameOpArea Dst, Src, add_type
-                        
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    
-    Select Case add_type
-        Case ADD_CODE_PRICE
-            Dst.Worksheet.Columns("E:E").NumberFormat = "0.0000"
-        Case ADD_CODE_TRAFFIC
-            Dst.Worksheet.Columns("F:F").NumberFormat = "0.00"
-    End Select
-    
-    Dst.Worksheet.Columns("A:H").AutoFit
-    
-    Set Dst = Dst.Worksheet.Range("A1")
-End Sub
-
-Sub BuildAreasStatus(wks_name As String)
-    Dim rSrc As Range
-    Dim rDst As Range
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim j As Integer
-    Dim s As String
-    Dim WS_Name As String
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        
-' ��������� ������ ������
-
-        Dim AreaCount As Integer
-
-        AreaCount = 3
-        Set rDst = .Worksheets(wks_name).Range(WKS_A3)
-        While rDst <> ""
-            Set rDst = rDst.Offset(1, 0)
-            AreaCount = AreaCount + 1
-        Wend
-
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        Set rDst = .Worksheets(wks_name).Range(WKS_A3)
-        j = 3
-        
-        For i = 1 To ListsRange.Count
-            rDst.Offset(-1, i + idx_GLStatus).Formula = ListsRange(i, 1)
-        Next i
-        
-' ��������� ������� ��� ��� ������ ����������
-        While rDst <> ""
-            For i = 1 To ListsRange.Count
-                WS_Name = ListsRange(i, 1)
-                s = "INDEX(" & WS_Name & "!G1:$G$" & AreaCount & ", MATCH($A" & j & "," & WS_Name & "!$A$1:$A$" & AreaCount & ",0), 1)"
-                s = "=if(iserror(" & s & "), ""-""," & s & ")"
-                rDst.Offset(0, i + idx_GLStatus).Formula = s
-                rDst.Offset(0, i + idx_GLStatus).NumberFormat = "0#"
-            Next i
-            j = j + 1
-            Set rDst = rDst.Offset(1, 0)
-        Wend
-        
-' ����������� ���������
-        For i = 0 To ListsRange.Count
-            With rDst.Offset(-1, i + idx_GLStatus).EntireColumn
-                .HorizontalAlignment = xlCenter
-                .ShrinkToFit = True
-            End With
-        Next i
-
-' ������������ �������� ���
-
-        With .Worksheets(wks_name)
-            Set rDst = .Range(.Cells(3, 1), .Cells(AreaCount, 1))
-        End With
-
-        AreaCount = 3
-        Set rSrc = .Worksheets(WKS_FIX_AREAS_NAME).Range(WKS_A3)
-        While rSrc <> ""
-            Set rSrc = rSrc.Offset(1, 0)
-            AreaCount = AreaCount + 1
-        Wend
-
-        With .Worksheets(WKS_FIX_AREAS_NAME)
-            Set rSrc = .Range(.Cells(2, 1), .Cells(AreaCount, 1))
-        End With
-
-        Dim b As Range
-        Dim c As Range
-        For Each c In rDst
-            Set b = rSrc.Find(c, LookIn:=xlValues, MatchByte:=True)
-            If Not b Is Nothing Then
-                If c.Offset(0, idx_eDescr) <> b.Offset(0, idx_eDescr) Or c.Offset(0, idx_rDescr) <> b.Offset(0, idx_rDescr) Then
-                    c.Offset(0, idx_eDescr) = b.Offset(0, idx_eDescr)
-                    c.Offset(0, idx_rDescr) = b.Offset(0, idx_rDescr)
-                    c.Offset(0, idx_GLStatus) = "Fixed"
-                    With c.EntireRow
-                        .Font.Bold = True
-                        .Font.ColorIndex = xlColorIndexAutomatic
-                    End With
-                Else
-                    c.Offset(0, idx_GLStatus) = "-"
-                End If
-            Else
-                Dim FixedList As Range
-                c.Offset(0, idx_GLStatus) = "New"
-                With c.EntireRow
-                    .Font.Bold = True
-                    .Font.ColorIndex = 3 ' Red
-                End With
-                
-'                Set Fixed
-            End If
-        Next c
-        
-        Application.ScreenUpdating = True
-        
-    End With
-End Sub
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Sub ClearWorkArea(DstName As String)
-    Dim DstRange As Range
-    With ThisWorkbook
-       
-        Set DstRange = .Worksheets(DstName).Range(WKS_A3)
-        Worksheets(DstName).Select
-        DstRange.Select
-        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
-        Range(Selection, Selection.End(xlDown)).Select
-        Selection.Delete Shift:=xlUp
-        Selection.Font.Bold = False
-        Selection.Font.ColorIndex = xlColorIndexAutomatic
-        Set DstRange = .Worksheets(DstName).Range(WKS_A3)
-        DstRange.Select
-    End With
-End Sub
-
-Function SheetExist(SheetName As String) As Boolean
-    Dim Count, i As Integer
-
-    Count = ThisWorkbook.Sheets.Count
-    SheetExist = False
-    For i = 1 To Count
-        If ThisWorkbook.Sheets(i).Name = SheetName Then
-            SheetExist = True
-            i = Count
-        End If
-    Next i
-End Function
-
-Function GetLinesCount(r As Range) As Integer
-
-    Dim LinesCount As Integer
-    LinesCount = 0
-
-    While r <> ""
-        LinesCount = LinesCount + 1
-        Set r = r.Offset(1, 0)
-    Wend
-    
-    GetLinesCount = LinesCount
-End Function
-
-Sub CreateComSheet(wks_name As String)
-    Dim theRange As Range
-    With ThisWorkbook
-        If Not SheetExist(wks_name) Then
-            .Sheets.Add.Name = wks_name
-        End If
-            
-        .Sheets(wks_name).Visible = True
-        .Sheets(wks_name).Select
-        Cells.Select
-        Selection.ClearContents
-        Selection.Interior.ColorIndex = xlNone
-        Selection.Borders(xlLeft).LineStyle = xlNone
-        Selection.Borders(xlRight).LineStyle = xlNone
-        Selection.Borders(xlTop).LineStyle = xlNone
-        Selection.Borders(xlBottom).LineStyle = xlNone
-        Selection.BorderAround LineStyle:=xlNone
-        Selection.Font.ColorIndex = 0
-        Selection.EntireColumn.ColumnWidth = ActiveSheet.StandardWidth
-    
-        With .Worksheets(wks_name)
-            .Range("a1") = wks_name
-            With .Range("a2")
-                .Offset(0, idx_sCode) = "sCode"
-                .Offset(0, idx_Code) = "Code"
-                .Offset(0, idx_eDescr) = "Descr_E"
-                .Offset(0, idx_rDescr) = "Descr_R"
-                .Offset(0, idx_Price) = "Price"
-                .Offset(0, idx_Traffic) = "Traffic"
-                .Offset(0, idx_Status) = "Status"
-                .Offset(0, idx_Price2) = "Price2"
-            End With
-            With .Rows("2:2")
-                .Font.Bold = False
-                .WrapText = False
-                .HorizontalAlignment = xlCenter
-            End With
-            .Range("A1").Select
-        End With
-    End With
-End Sub
-
-Function GetGlobalAreaIdx(wks_name As String, AreaCount As Integer, scDst, scSrc) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim Answer As Integer
-    
-    GetGlobalAreaIdx = -1
-    
-    With ThisWorkbook.Worksheets(wks_name)
-        For i = Len(scSrc) To 2 Step -1
-            s = Left(scSrc, i)
-            If InStr(scDst, s) And i > 1 Then
-                Answer = FindVIndex(.Range("A:A"), AreaCount, s)
-                If Answer > 0 Then
-                    GetGlobalAreaIdx = Answer
-                    Exit Function
-                End If
-            End If
-        Next i
-    End With
-End Function
-
-
-Function FindVIndex(Src As Range, AreaCount As Integer, s As String) As Integer
-    Dim l As Long
-    FindVIndex = -1
-    For l = 1 To AreaCount
-        If s = Src.Cells(l, 1) Then
-            FindVIndex = l
-            Exit Function
-        End If
-    Next l
-End Function
-
-Sub MarkDublicates(Src As Range)
-    Dim Dst As Range
-    Set Dst = Src.Offset(1, 0)
-    While Dst <> ""
-        If Dst = Src Then
-            With Dst.EntireRow
-                .Font.Bold = True
-                .Font.ColorIndex = 3
-            End With
-            Set Dst = Dst.Offset(1, 0)
-        Else
-            Set Src = Dst
-            Set Dst = Src.Offset(1, 0)
-        End If
-    Wend
-End Sub
-
-<<<<<<
-======================
-Constatnts
->>>>>>
-Attribute VB_Name = "Constatnts"
-Option Explicit
-
-Public Const UNKNOWN_AREA As String = "UNKNOWN_AREA"
-Public Const NONAME_AREA As String = "*"
-
-Public Const WKS_AREAS_NAME As String = "GlobalList"
-Public Const WKS_PRICE_NAME As String = "OpPrices"
-Public Const WKS_TRAFFIC_NAME As String = "OpTraffic"
-Public Const WKS_FIX_AREAS_NAME As String = "GLFixed"
-Public Const WKS_HOME_NAME As String = "Home"
-
-Public Const WKS_A3 As String = "A3"
-Public Const idx_sCode As Integer = 0
-Public Const idx_Code As Integer = 1
-Public Const idx_eDescr As Integer = 2
-Public Const idx_rDescr As Integer = 3
-Public Const idx_Price As Integer = 4
-Public Const idx_Traffic As Integer = 5
-Public Const idx_Status As Integer = 6
-Public Const idx_Price2 As Integer = 7
-
-Public Const idx_DatTraffic As Integer = 2
-Public Const idx_GLStatus As Integer = 4
-
-Public Const ADD_CODE_ONLY As Integer = 0
-Public Const ADD_CODE_PRICE As Integer = 1
-Public Const ADD_CODE_TRAFFIC As Integer = 2
-
-
-
-
-Sub AnalyzePrices()
-    AnalyzeOpPricesData WKS_PRICE_NAME, "0.0000"
-End Sub
-
-
-Sub AnalyzeData()
-'    AnalyzeOpPricesData WKS_TRAFFIC_NAME, "0."
-    MsgBox "This code not debuged"
-End Sub
-
-<<<<<<
-======================
-ForecastPrice
->>>>>>
-Attribute VB_Name = "ForecastPrice"
-Option Explicit
-
-Sub ForecastBlankCodes()
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim AreaCount As Integer
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim r As Range
-        
-        AreaCount = 0
-        Set r = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3)
-        While r <> ""
-            AreaCount = AreaCount + 1
-            Set r = r.Offset(1, 0)
-        Wend
-
-        For i = 1 To ListsRange.Count
-            Set r = .Worksheets(WKS_PRICE_NAME).Range(WKS_A3).Offset(0, idx_PriceIN + i - 1)
-            DoForecast r, AreaCount
-        Next i
-    End With
-End Sub
-
-
-Sub DoForecast(Src As Range, AreaCount As Integer)
-    Dim i As Integer
-    Dim Dst As Range
-    Dim scSrc As String
-    Dim scDst As String
-    
-    Static PriceAvailable As Boolean
-    
-    With ThisWorkbook
-        Set Dst = Src.Offset(1, 0)
-    
-        For i = 1 To AreaCount
-            PriceAvailable = Application.WorksheetFunction.IsNumber(Dst)
-            
-            If PriceAvailable = True Then
-                Set Src = Dst
-                Set Dst = Src.Offset(1, 0)
-            Else
-                scSrc = .Worksheets(WKS_PRICE_NAME).Range("A:A").Cells(Src.Row, 1)
-                scDst = .Worksheets(WKS_PRICE_NAME).Range("A:A").Cells(Dst.Row, 1)
-                
-                Dim idx As Integer
-                
-                idx = GetGlobalAreaIdx(WKS_AREAS_NAME, AreaCount, scDst, scSrc)
-                If idx <> -1 Then
-                    Set Src = .Worksheets(WKS_PRICE_NAME).Cells(idx, Src.Column)
-                    
-                    Dst = Src
-                    Dst.Font.Bold = False
-                    Dst.Font.ColorIndex = 29 ' magenta
-                    Set Dst = Dst.Offset(1, 0)
-                Else
-'                    Dst = "*"
-'                    Dst.Font.ColorIndex = xlColorIndexAutomatic
-'                    Dst.Font.Bold = True
-                    Set Dst = Dst.Offset(1, 0)
-                End If
-            End If
-        Next i
-    End With
-End Sub
-
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet27
->>>>>>
-Attribute VB_Name = "Sheet27"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet35
->>>>>>
-Attribute VB_Name = "Sheet35"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet32
->>>>>>
-Attribute VB_Name = "Sheet32"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet33
->>>>>>
-Attribute VB_Name = "Sheet33"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet34
->>>>>>
-Attribute VB_Name = "Sheet34"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet28
->>>>>>
-Attribute VB_Name = "Sheet28"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-Type PriceRecord
-    Aria As String
-    Description As String
-    Description2 As String
-    Price As Double
-End Type
-
-Dim SourcePrData() As PriceRecord
-
-Sub a()
-    ReDim SourcePrData(1 To 5)
-    Erase SourcePrData
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Home_Click()
-Attribute Home_Click.VB_Description = "Macro recorded 11/04/2001 by Nickolai Garbuz"
-Attribute Home_Click.VB_ProcData.VB_Invoke_Func = " \n14"
-    Sheets("Home").Select
-    Range("A1").Select
-End Sub
-Sub CPriceDraft_Click()
-    Sheets("Price.Draft").Select
-    Range("A1").Select
-End Sub
-Sub COperSetup_Click()
-    Sheets("Operators.Setup").Select
-    Range("A1").Select
-End Sub
-Sub COperPrice_Click()
-    Sheets("Operators.Price").Select
-    Range("A1").Select
-End Sub
-Sub CDealerSetup_Click()
-    Sheets("Dealers.Setup").Select
-    Range("A1").Select
-End Sub
-Sub CDealerPrice_Click()
-    Sheets("Dealers.Price").Select
-    Range("A1").Select
-End Sub
-
-Sub CClientSetup_Click()
-    Sheets("Corporate.Setup").Select
-    Range("A1").Select
-End Sub
-Sub CClientGPL_Click()
-    Sheets("Corporate.GPL").Select
-    Range("A1").Select
-End Sub
-Sub CClientGPL10_Click()
-    Sheets("Corporate.GPL-10").Select
-    Range("A1").Select
-End Sub
-Sub CClientGPL20_Click()
-    Sheets("Corporate.GPL-20").Select
-    Range("A1").Select
-End Sub
-
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-mAnalisys
->>>>>>
-Attribute VB_Name = "mAnalisys"
-Option Explicit
-
-
-Sub AnalyzeOpPricesData(wks_name As String, DATA_fmt As String)
-
-' ��������� ������ ��� �� ������� �����
-' ������� ���������� ������
-    ClearWorkArea (wks_name)
-
-' �������� ��������� ������ �� ������� ����
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        Set DstRange = .Worksheets(wks_name).Range("A3")
-        Set SrcRange = .Worksheets(WKS_AREAS_NAME).Range("A3")
-  
-        CopyAreasList DstRange, SrcRange
-        
-        Set DstRange = .Worksheets(wks_name).Range("A3")
-    End With
-
-' ������������ ����� ���������� ���
-
-    Dim AreaCount As Integer
-    AreaCount = GetLinesCount(DstRange)
-
-
-' ����������� ���������� ���������
-    Dim i As Integer
-        
-    For i = 1 To 3
-        Set DstRange = ThisWorkbook.Worksheets(wks_name) _
-                    .Range(Cells(2, i), Cells(2 + AreaCount, i))
-        With DstRange
-            .EntireColumn.AutoFit
-            If i Mod 2 = 1 Then
-                .Interior.ColorIndex = 36 ' LightYellow
-            Else
-                .Interior.ColorIndex = xlNone  'White
-            End If
-        End With
-    Next i
-
-' ���������� ����/������ ���� ���������� � ��������� ����� ������ ��� �� �����
-' �������� ���� ���������� ��� ���
-
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-    
-        For i = 1 To ListsRange.Count
-            Set DstRange = .Worksheets(wks_name).Range("A3")
-            s = ListsRange.Cells(i, 1).Value
-            If wks_name = WKS_TRAFFIC_NAME Then
-                s = s & ".Data"
-            End If
-            Set SrcRange = .Worksheets(s).Range("A3")
-
-            AddOpPriceData DstRange, SrcRange, i
-            
-' ����������� ���������� ���������
-            With .Worksheets(wks_name)
-                Set DstRange = .Range(.Cells(2, 3 + i), .Cells(2 + AreaCount, 3 + i))
-            End With
-            With DstRange
-                .NumberFormat = DATA_fmt
-                .HorizontalAlignment = xlCenter
-                .VerticalAlignment = xlBottom
-                .WrapText = False
-                .Orientation = 0
-                .AddIndent = False
-                .ShrinkToFit = False
-                .MergeCells = False
-                If i Mod 2 = 0 Then
-                    .Interior.ColorIndex = 36 ' LightYellow
-                Else
-                    .Interior.ColorIndex = xlNone  'White
-                End If
-            End With
-        Next i
-        With Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, 4), .Cells(2 + AreaCount, 9))
-        End With
-        
-        For Each SrcRange In DstRange
-            If SrcRange = "" Then
-                SrcRange = "-"
-            End If
-        Next SrcRange
-        
-        Set SrcRange = .Worksheets(wks_name).Range("A3")
-    End With
-    
-' ������������ ���������� �� �����
-    Set DstRange = ThisWorkbook.Worksheets(wks_name).Range("J3")
-    DstRange.Select
-        
-    For i = 0 To AreaCount - 1
-        s = "(D" & i + 3 & ":I" & i + 3 & ")"
-        DstRange.Offset(i, 0).Formula = "=count" + s
-        DstRange.Offset(i, 1).Formula = "=if(J" & i + 3 & ">0, min" & s & ", ""-"")"
-        DstRange.Offset(i, 2).Formula = "=if(J" & i + 3 & ">0, max" & s & ", ""-"")"
-        DstRange.Offset(i, 3).Formula = "=if(J" & i + 3 & ">0, average" & s & ", ""-"")"
-        s = "=if(J" & (i + 3) & ">0, (M" & (i + 3) & "-K" & (i + 3) & ")/M" & (i + 3) & ", ""-"")"
-        DstRange.Offset(i, 4).Formula = s
-        s = "=if(J" & i + 3 & ">0, (L" & (i + 3) & "-M" & (i + 3) & ")/M" & (i + 3) & ", ""-"")"
-        DstRange.Offset(i, 5).Formula = s
-    Next i
-
-' ����������� ���������� ���������
-    For i = 0 To 5
-        With ThisWorkbook.Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, 10 + i), .Cells(2 + AreaCount, 10 + i))
-        End With
-        With DstRange
-            If i <> 0 Then
-                .NumberFormat = DATA_fmt
-            End If
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-            .WrapText = False
-            .Orientation = 0
-            .AddIndent = False
-            .ShrinkToFit = False
-            .MergeCells = False
-            If i Mod 2 = 0 Then
-                .Interior.ColorIndex = 35 ' LightLightGreen
-            Else
-                .Interior.ColorIndex = 34  ' LightLightBlue
-            End If
-            .Application.ScreenUpdating = True
-
-        End With
-    Next i
-End Sub
-
-Sub CopyAreasList(Dst As Range, Src As Range)
-    While Src <> ""
-        Dst = Src
-        Dst.Offset(0, 1) = Src.Offset(0, 1)
-        Dst.Offset(0, 2) = Src.Offset(0, 2)
-        Set Src = Src.Offset(1, 0)
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-
-Sub AddOpPriceData(Dst As Range, Src As Range, index As Integer)
-    While Src <> ""
-        If Dst < Src Then
-            Dst.Offset(0, 2 + index) = "-"
-        End If
-        If Dst = Src Then
-            Dst.Offset(0, 2 + index) = Src.Offset(0, 3)
-            Set Src = Src.Offset(1, 0)
-        End If
-        Dst.Offset(0, 2 + index).Font.Bold = True
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    While Dst <> ""
-        Dst.Offset(0, 2 + index) = "-"
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-
-End Sub
-
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-GlobalList
->>>>>>
-Attribute VB_Name = "GlobalList"
-Option Explicit
-
-
-
-Sub CreateGlobalCodeList()
-
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-' ������� ���������� ������
-    ClearWorkArea (WKS_AREAS_NAME)
-    
-' ��������� ����� ������ ���
-
-    BuildAreasList (WKS_AREAS_NAME)
-    
-    BuildAreasStatus (WKS_AREAS_NAME)
-
-End Sub
-
-Sub BuildWorkPriceLists()
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            CreateSheet (s)
-            
-            Set DstRange = .Worksheets(s).Range("A3")
-            Set SrcRange = .Worksheets(s & ".Tarif").Range("A3")
-            
-            AddOpArea DstRange, SrcRange, 1
-            
-            Set DstRange = .Worksheets(s).Range("A3")
-            Set SrcRange = .Worksheets(s & ".Data").Range("A3")
-            
-            AddOpArea DstRange, SrcRange, 2
-            
-' ����������� ����� ������:
-' 00 - �� ���������, �� ������������
-' 01 - �� ���������, ������������
-' 10 - ���������, �� ������������
-' 11 - ���������, ������������
-            
-            Set DstRange = .Worksheets(s).Range("A3")
-            While DstRange <> ""
-                If DstRange.Offset(0, 3) = 0 Or DstRange.Offset(0, 3) = "-" Then
-                    If DstRange.Offset(0, 4) = 0 Then
-                        DstRange.Offset(0, 5) = 0
-                    Else
-                        DstRange.Offset(0, 5) = 1
-                    End If
-                Else
-                    If DstRange.Offset(0, 4) = 0 Then
-                        DstRange.Offset(0, 5) = 10
-                    Else
-                        DstRange.Offset(0, 5) = 11
-                    End If
-                End If
-                Set DstRange = DstRange.Offset(1, 0)
-            Wend
-                
-            With .Worksheets(s).Columns("A:F")
-                .HorizontalAlignment = xlHAlignGeneral
-                .VerticalAlignment = xlBottom
-                .WrapText = False
-                .Orientation = 0
-                .AddIndent = False
-                .ShrinkToFit = True
-                .MergeCells = False
-            End With
-            .Worksheets(s).Columns("F:F").HorizontalAlignment = xlHAlignCenter
-
-        Next i
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-    End With
-
-End Sub
-
-Sub BuildAreasList(DstName As String)
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            Set DstRange = .Worksheets(WKS_AREAS_NAME).Range("A3")
-            Set SrcRange = .Worksheets(s).Range("A3")
-        
-            AddOpArea DstRange, SrcRange
-        Next i
-        Set SrcRange = .Worksheets(DstName).Range("A3")
-        .Worksheets(DstName).Select
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-    End With
-End Sub
-
-Sub AddOpArea(Dst As Range, Src As Range, Optional add_field_num = 0)
-    
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst = Src
-            Dst.Offset(0, 1) = Src.Offset(0, 1)
-            Dst.Offset(0, 2) = Src.Offset(0, 2)
-            If (Dst.Offset(0, 2) = "") Then
-                Dst.Offset(0, 2) = UNKNOWN_AREA
-            End If
-        End If
-        If Dst = Src Then
-            If Dst.Offset(0, 2) = UNKNOWN_AREA And Src.Offset(0, 2) <> UNKNOWN_AREA And Src.Offset(0, 2) <> "" Then
-                Dst.Offset(0, 2) = Src.Offset(0, 2)
-            End If
-            
-            Select Case add_field_num
-                Case 1
-                    Dst.Offset(0, 3) = Src.Offset(0, 3)
-                    If Dst.Offset(0, 3) = "" Then
-                        Dst.Offset(0, 3) = "-"
-                    End If
-                Case 2
-                    Dst.Offset(0, 4) = Src.Offset(0, 3)
-            End Select
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    
-    Select Case add_field_num
-        Case 1
-            Dst.Worksheet.Columns("D:D").NumberFormat = "0.0000"
-        Case 2
-            Dst.Worksheet.Columns("E:E").NumberFormat = "0.00"
-    End Select
-    
-    Dst.Worksheet.Columns("A:E").AutoFit
-    
-    Set Dst = Dst.Worksheet.Range("A1")
-End Sub
-
-Sub BuildAreasStatus(wks_name As String)
-    Dim rSrc As Range
-    Dim rDst As Range
-    Dim i As Integer
-        
-    With ThisWorkbook
-        Set rDst = .Worksheets(wks_name).Range("A3")
-        i = 3
-        
-        .Application.ScreenUpdating = False
-
-' ��������� ������� ��� ��� ������ ����������
-        While rDst <> ""
-            rDst.Offset(0, 4).Formula = "=INDEX(Edge2Net!F1:$F$1500, MATCH($A" & i & ",Edge2Net!$A$1:$A$1500,0), 1)"
-            rDst.Offset(0, 5).Formula = "=INDEX(LineCom!F1:$F$1500, MATCH($A" & i & ",LineCom!$A$1:$A$1500,0), 1)"
-            rDst.Offset(0, 6).Formula = "=INDEX(MTX!F1:$F$1500, MATCH($A" & i & ",MTX!$A$1:$A$1500,0), 1)"
-            rDst.Offset(0, 7).Formula = "=INDEX(Elcatel!F1:$F$1500, MATCH($A" & i & ",Elcatel!$A$1:$A$1500,0), 1)"
-            rDst.Offset(0, 8).Formula = "=INDEX(MC_MTT!F1:$F$1500, MATCH($A" & i & ",MC_MTT!$A$1:$A$1500,0), 1)"
-            rDst.Offset(0, 9).Formula = "=INDEX(Nova!F1:$F$1500, MATCH($A" & i & ",Nova!$A$1:$A$1500,0), 1)"
-            
-            i = i + 1
-            Set rDst = rDst.Offset(1, 0)
-        Wend
-        
-' ������������ �������� ���
-        Dim AreaCount As Integer
-
-        AreaCount = 3
-        Set rDst = .Worksheets(wks_name).Range("A3")
-        While rDst <> ""
-            Set rDst = rDst.Offset(1, 0)
-            AreaCount = AreaCount + 1
-        Wend
-
-        With .Worksheets(wks_name)
-            Set rDst = .Range(.Cells(3, 1), .Cells(AreaCount, 1))
-        End With
-
-        AreaCount = 3
-        Set rSrc = .Worksheets(WKS_FIX_AREAS_NAME).Range("A3")
-        While rSrc <> ""
-            Set rSrc = rSrc.Offset(1, 0)
-            AreaCount = AreaCount + 1
-        Wend
-
-        With .Worksheets(WKS_FIX_AREAS_NAME)
-            Set rSrc = .Range(.Cells(2, 1), .Cells(AreaCount, 1))
-        End With
-
-        Dim b As Range
-        Dim c As Range
-
-        For Each c In rDst
-            Set b = rSrc.Find(c, LookIn:=xlValues, MatchByte:=True)
-            If Not b Is Nothing Then
-                If c.Offset(0, 2) <> b.Offset(0, 2) Then
-                    c.Offset(0, 2) = b.Offset(0, 2)
-                    c.Offset(0, 3) = "Fixed"
-                    With .Worksheets(wks_name).Range(c.Offset(0, 0), c.Offset(0, 3))
-                        .Font.Bold = True
-                        .Font.ColorIndex = xlColorIndexAutomatic
-                    End With
-                Else
-                    c.Offset(0, 3) = "-"
-                End If
-            Else
-                Dim FixedList As Range
-                c.Offset(0, 3) = "New"
-                With .Worksheets(wks_name).Range(c.Offset(0, 0), c.Offset(0, 3))
-                    .Font.Bold = True
-                    .Font.ColorIndex = 3 ' Red
-                End With
-                
-'                Set Fixed
-            End If
-        Next c
-        
-        Application.ScreenUpdating = True
-        
-    End With
-End Sub
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Sub ClearWorkArea(DstName As String)
-    Dim DstRange As Range
-    With ThisWorkbook
-       
-        Set DstRange = .Worksheets(DstName).Range("A3")
-        Worksheets(DstName).Select
-        DstRange.Select
-        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
-        Range(Selection, Selection.End(xlDown)).Select
-        Selection.Delete Shift:=xlUp
-        Selection.Font.Bold = False
-        Selection.Font.ColorIndex = xlColorIndexAutomatic
-        Set DstRange = .Worksheets(DstName).Range("A3")
-        DstRange.Select
-    End With
-End Sub
-
-Function SheetExist(SheetName As String) As Boolean
-    Dim Count, i As Integer
-
-    Count = ThisWorkbook.Sheets.Count
-    SheetExist = False
-    For i = 1 To Count
-        If ThisWorkbook.Sheets(i).Name = SheetName Then
-            SheetExist = True
-            i = Count
-        End If
-    Next i
-End Function
-
-Function GetLinesCount(r As Range) As Integer
-
-    Dim LinesCount As Integer
-    LinesCount = 0
-
-    While r <> ""
-        LinesCount = LinesCount + 1
-        Set r = r.Offset(1, 0)
-    Wend
-    
-    GetLinesCount = LinesCount
-End Function
-
-Sub CreateSheet(wks_name As String)
-    Dim theRange As Range
-    With ThisWorkbook
-        If Not SheetExist(wks_name) Then
-            .Sheets.Add.Name = wks_name
-        End If
-            
-        .Sheets(wks_name).Visible = True
-        .Sheets(wks_name).Select
-        Cells.Select
-        Selection.ClearContents
-        Selection.Interior.ColorIndex = xlNone
-        Selection.Borders(xlLeft).LineStyle = xlNone
-        Selection.Borders(xlRight).LineStyle = xlNone
-        Selection.Borders(xlTop).LineStyle = xlNone
-        Selection.Borders(xlBottom).LineStyle = xlNone
-        Selection.BorderAround LineStyle:=xlNone
-        Selection.Font.ColorIndex = 0
-        Selection.EntireColumn.ColumnWidth = ActiveSheet.StandardWidth
-    
-        With .Worksheets(wks_name)
-            .Range("a1") = wks_name
-            .Range("a2") = "sCode"
-            .Range("b2") = "Code"
-            .Range("c2") = "Description"
-            .Range("d2") = "Price"
-            .Range("e2") = "Traffic"
-            .Range("f2") = "Status"
-            .Range("g2") = "Price2"
-            With .Range("a2:f2")
-                .Font.Bold = False
-                .WrapText = False
-                .HorizontalAlignment = xlCenter
-            End With
-            .Range("A1").Select
-        End With
-    End With
-End Sub
-
-Function GetGlobalAreaIdx(wks_name As String, AreaCount As Integer, scDst, scSrc) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim Answer As Integer
-    
-    GetGlobalAreaIdx = -1
-    
-    With ThisWorkbook.Worksheets(wks_name)
-        For i = Len(scSrc) To 1 Step -1
-            s = Left(scSrc, i)
-            If InStr(scDst, s) And i > 1 Then
-                Answer = FindVIndex(.Range("A:A"), AreaCount, s)
-                If Answer > 0 Then
-                    GetGlobalAreaIdx = Answer
-                    Exit Function
-                End If
-            End If
-        Next i
-    End With
-End Function
-
-
-Function FindVIndex(Src As Range, AreaCount As Integer, s As String) As Integer
-    Dim l As Long
-    FindVIndex = -1
-    For l = 1 To AreaCount
-        If s = Src.Cells(l, 1) Then
-            FindVIndex = l
-            Exit Function
-        End If
-    Next l
-End Function
-
-
-<<<<<<
-======================
-Constatnts
->>>>>>
-Attribute VB_Name = "Constatnts"
-Option Explicit
-
-Public Const UNKNOWN_AREA As String = "UNKNOWN_AREA"
-Public Const WKS_AREAS_NAME As String = "GlobalList"
-Public Const WKS_PRICE_NAME As String = "OpPrices"
-Public Const WKS_TRAFFIC_NAME As String = "OpTraffic"
-Public Const WKS_FIX_AREAS_NAME As String = "GLFixed"
-Public Const WKS_HOME_NAME As String = "Home"
-
-
-
-Sub AnalyzePrices()
-    AnalyzeOpPricesData WKS_PRICE_NAME, "0.0000"
-End Sub
-
-
-Sub AnalyzeData()
-    AnalyzeOpPricesData WKS_TRAFFIC_NAME, "0."
-End Sub
-
-<<<<<<
-======================
-ForecastPrice
->>>>>>
-Attribute VB_Name = "ForecastPrice"
-Option Explicit
-
-Sub ForecastBlankCodes()
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim AreaCount As Integer
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim r As Range
-        
-        AreaCount = 0
-        Set r = .Worksheets(WKS_PRICE_NAME).Range("A3")
-        While r <> ""
-            AreaCount = AreaCount + 1
-            Set r = r.Offset(1, 0)
-        Wend
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            Set r = .Worksheets(WKS_PRICE_NAME).Range("D2:I2").Find(s, LookIn:=xlValues, MatchByte:=True).Offset(1, 0)
-            DoForecast r, AreaCount
-        Next i
-    End With
-End Sub
-
-
-Sub DoForecast(Src As Range, AreaCount As Integer)
-    Dim i As Integer
-    Dim Dst As Range
-    Dim scSrc As String
-    Dim scDst As String
-    
-    Static PriceAvailable As Boolean
-    
-    With ThisWorkbook
-        Set Dst = Src.Offset(1, 0)
-    
-        If Application.WorksheetFunction.IsNumber(Src) = False Then
-            Src = "-"
-            Src.Font.Bold = True
-            Src.Font.ColorIndex = xlColorIndexAutomatic
-        End If
-        
-        For i = 1 To AreaCount
-            PriceAvailable = Application.WorksheetFunction.IsNumber(Dst)
-            
-            If PriceAvailable = True Then
-                Set Src = Dst
-                Set Dst = Src.Offset(1, 0)
-            Else
-                scSrc = .Worksheets(WKS_PRICE_NAME).Range("A:A").Cells(Src.Row, 1)
-                scDst = .Worksheets(WKS_PRICE_NAME).Range("A:A").Cells(Dst.Row, 1)
-                
-                Dim idx As Integer
-                
-                idx = GetGlobalAreaIdx(WKS_AREAS_NAME, AreaCount, scDst, scSrc)
-                If idx <> -1 Then
-                    Set Src = .Worksheets(WKS_PRICE_NAME).Cells(idx, Src.Column)
-                    
-                    Dst = Src
-                    Dst.Font.Bold = False
-                    Dst.Font.ColorIndex = 29 ' magenta
-                    Set Dst = Dst.Offset(1, 0)
-                Else
-                    Dst = "-"
-                    Dst.Font.ColorIndex = xlColorIndexAutomatic
-                    Dst.Font.Bold = True
-                    Set Dst = Dst.Offset(1, 0)
-                End If
-            End If
-        Next i
-    End With
-End Sub
-
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-mAnalisys
->>>>>>
-Attribute VB_Name = "mAnalisys"
-Option Explicit
-
-
-Sub AnalyzeOpPricesData(wks_name As String, DATA_fmt As String)
-
-' ��������� ������ ��� �� ������� �����
-' ������� ���������� ������
-    ClearWorkArea (wks_name)
-
-' �������� ��������� ������ �� ������� ����
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-        
-        Set DstRange = .Worksheets(wks_name).Range("A3")
-        Set SrcRange = .Worksheets(WKS_AREAS_NAME).Range("A3")
-  
-        CopyAreasList DstRange, SrcRange
-        
-        Set DstRange = .Worksheets(wks_name).Range("A3")
-    End With
-
-' ������������ ����� ���������� ���
-
-    Dim AreaCount As Integer
-    AreaCount = GetLinesCount(DstRange)
-
-
-' ����������� ���������� ���������
-    Dim i As Integer
-        
-    For i = 1 To 3
-        Set DstRange = ThisWorkbook.Worksheets(wks_name) _
-                    .Range(Cells(2, i), Cells(2 + AreaCount, i))
-        With DstRange
-            .EntireColumn.AutoFit
-            If i Mod 2 = 1 Then
-                .Interior.ColorIndex = 36 ' LightYellow
-            Else
-                .Interior.ColorIndex = xlNone  'White
-            End If
-        End With
-    Next i
-
-' ���������� ����/������ ���� ���������� � ��������� ����� ������ ��� �� �����
-' �������� ���� ���������� ��� ���
-
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-    
-        For i = 1 To ListsRange.Count
-            Set DstRange = .Worksheets(wks_name).Range("A3")
-            s = ListsRange.Cells(i, 1).Value
-            If wks_name = WKS_TRAFFIC_NAME Then
-                s = s & ".Data"
-            End If
-            Set SrcRange = .Worksheets(s).Range("A3")
-
-            AddOpPriceData DstRange, SrcRange, i
-            
-' ����������� ���������� ���������
-            With .Worksheets(wks_name)
-                Set DstRange = .Range(.Cells(2, 3 + i), .Cells(2 + AreaCount, 3 + i))
-            End With
-            With DstRange
-                .NumberFormat = DATA_fmt
-                .HorizontalAlignment = xlCenter
-                .VerticalAlignment = xlBottom
-                .WrapText = False
-                .Orientation = 0
-                .AddIndent = False
-                .ShrinkToFit = False
-                .MergeCells = False
-                If i Mod 2 = 0 Then
-                    .Interior.ColorIndex = 36 ' LightYellow
-                Else
-                    .Interior.ColorIndex = xlNone  'White
-                End If
-            End With
-        Next i
-        With Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, 4), .Cells(2 + AreaCount, 9))
-        End With
-        
-        For Each SrcRange In DstRange
-            If SrcRange = "" Then
-                SrcRange = "-"
-            End If
-        Next SrcRange
-        
-        Set SrcRange = .Worksheets(wks_name).Range("A3")
-    End With
-    
-' ������������ ���������� �� �����
-    Set DstRange = ThisWorkbook.Worksheets(wks_name).Range("J3")
-    DstRange.Select
-        
-    For i = 0 To AreaCount - 1
-        s = "(D" & i + 3 & ":I" & i + 3 & ")"
-        DstRange.Offset(i, 0).Formula = "=count" + s
-        DstRange.Offset(i, 1).Formula = "=if(J" & i + 3 & ">0, min" & s & ", ""-"")"
-        DstRange.Offset(i, 2).Formula = "=if(J" & i + 3 & ">0, max" & s & ", ""-"")"
-        DstRange.Offset(i, 3).Formula = "=if(J" & i + 3 & ">0, average" & s & ", ""-"")"
-        s = "=if(J" & (i + 3) & ">0, (M" & (i + 3) & "-K" & (i + 3) & ")/M" & (i + 3) & ", ""-"")"
-        DstRange.Offset(i, 4).Formula = s
-        s = "=if(J" & i + 3 & ">0, (L" & (i + 3) & "-M" & (i + 3) & ")/M" & (i + 3) & ", ""-"")"
-        DstRange.Offset(i, 5).Formula = s
-    Next i
-
-' ����������� ���������� ���������
-    For i = 0 To 5
-        With ThisWorkbook.Worksheets(wks_name)
-            Set DstRange = .Range(.Cells(2, 10 + i), .Cells(2 + AreaCount, 10 + i))
-        End With
-        With DstRange
-            If i <> 0 Then
-                .NumberFormat = DATA_fmt
-            End If
-            .HorizontalAlignment = xlCenter
-            .VerticalAlignment = xlBottom
-            .WrapText = False
-            .Orientation = 0
-            .AddIndent = False
-            .ShrinkToFit = False
-            .MergeCells = False
-            If i Mod 2 = 0 Then
-                .Interior.ColorIndex = 35 ' LightLightGreen
-            Else
-                .Interior.ColorIndex = 34  ' LightLightBlue
-            End If
-            .Application.ScreenUpdating = True
-
-        End With
-    Next i
-End Sub
-
-Sub CopyAreasList(Dst As Range, Src As Range)
-    While Src <> ""
-        Dst = Src
-        Dst.Offset(0, 1) = Src.Offset(0, 1)
-        Dst.Offset(0, 2) = Src.Offset(0, 2)
-        Set Src = Src.Offset(1, 0)
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-
-Sub AddOpPriceData(Dst As Range, Src As Range, index As Integer)
-    While Src <> ""
-        If Dst < Src Then
-            Dst.Offset(0, 2 + index) = "-"
-        End If
-        If Dst = Src Then
-            Dst.Offset(0, 2 + index) = Src.Offset(0, 3)
-            Set Src = Src.Offset(1, 0)
-        End If
-        Dst.Offset(0, 2 + index).Font.Bold = True
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    While Dst <> ""
-        Dst.Offset(0, 2 + index) = "-"
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-
-End Sub
-
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-GlobalList
->>>>>>
-Attribute VB_Name = "GlobalList"
-Option Explicit
-
-
-
-Sub CreateGlobalCodeList()
-
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-' ������� ���������� ������
-    ClearWorkArea (WKS_AREAS_NAME)
-    
-' ��������� ����� ������ ���
-
-    BuildAreasList (WKS_AREAS_NAME)
-    
-    BuildAreasStatus (WKS_AREAS_NAME)
-
-End Sub
-
-Sub BuildWorkPriceLists()
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            CreateSheet (s)
-            
-            Set DstRange = .Worksheets(s).Range("A3")
-            Set SrcRange = .Worksheets(s & ".Tarif").Range("A3")
-            
-            AddOpArea DstRange, SrcRange, 1
-            
-            Set DstRange = .Worksheets(s).Range("A3")
-            Set SrcRange = .Worksheets(s & ".Data").Range("A3")
-            
-            AddOpArea DstRange, SrcRange, 2
-            
-' ����������� ����� ������:
-' 00 - �� ���������, �� ������������
-' 01 - �� ���������, ������������
-' 10 - ���������, �� ������������
-' 11 - ���������, ������������
-            
-            Set DstRange = .Worksheets(s).Range("A3")
-            While DstRange <> ""
-                If DstRange.Offset(0, 3) = 0 Or DstRange.Offset(0, 3) = "-" Then
-                    If DstRange.Offset(0, 4) = 0 Then
-                        DstRange.Offset(0, 5) = 0
-                    Else
-                        DstRange.Offset(0, 5) = 1
-                    End If
-                Else
-                    If DstRange.Offset(0, 4) = 0 Then
-                        DstRange.Offset(0, 5) = 10
-                    Else
-                        DstRange.Offset(0, 5) = 11
-                    End If
-                End If
-                Set DstRange = DstRange.Offset(1, 0)
-            Wend
-                
-            With .Worksheets(s).Columns("A:F")
-                .HorizontalAlignment = xlHAlignGeneral
-                .VerticalAlignment = xlBottom
-                .WrapText = False
-                .Orientation = 0
-                .AddIndent = False
-                .ShrinkToFit = True
-                .MergeCells = False
-            End With
-            .Worksheets(s).Columns("F:F").HorizontalAlignment = xlHAlignCenter
-
-        Next i
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-    End With
-
-End Sub
-
-Sub BuildAreasList(DstName As String)
-
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-    
-        With .Application
-            .Calculation = xlCalculationManual
-            .ScreenUpdating = False
-        End With
-' ���������� �������� ���� ���������� � ��������� ����� ������ ���
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            
-            Set DstRange = .Worksheets(WKS_AREAS_NAME).Range("A3")
-            Set SrcRange = .Worksheets(s).Range("A3")
-        
-            AddOpArea DstRange, SrcRange
-        Next i
-        Set SrcRange = .Worksheets(DstName).Range("A3")
-        .Worksheets(DstName).Select
-        With .Application
-            .Calculation = xlCalculationAutomatic
-            .ScreenUpdating = True
-            .Calculate
-        End With
-    End With
-End Sub
-
-Sub AddOpArea(Dst As Range, Src As Range, Optional add_field_num = 0)
-    
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst = Src
-            Dst.Offset(0, 1) = Src.Offset(0, 1)
-            Dst.Offset(0, 2) = Src.Offset(0, 2)
-            If (Dst.Offset(0, 2) = "") Then
-                Dst.Offset(0, 2) = UNKNOWN_AREA
-            End If
-        End If
-        If Dst = Src Then
-            If Dst.Offset(0, 2) = UNKNOWN_AREA And Src.Offset(0, 2) <> UNKNOWN_AREA And Src.Offset(0, 2) <> "" Then
-                Dst.Offset(0, 2) = Src.Offset(0, 2)
-            End If
-            
-            Select Case add_field_num
-                Case 1
-                    Dst.Offset(0, 3) = Src.Offset(0, 3)
-                    If Dst.Offset(0, 3) = "" Then
-                        Dst.Offset(0, 3) = "-"
-                    End If
-                Case 2
-                    Dst.Offset(0, 4) = Src.Offset(0, 3)
-            End Select
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-    
-    Select Case add_field_num
-        Case 1
-            Dst.Worksheet.Columns("D:D").NumberFormat = "0.0000"
-        Case 2
-            Dst.Worksheet.Columns("E:E").NumberFormat = "0.00"
-    End Select
-    
-    Dst.Worksheet.Columns("A:E").AutoFit
-    
-    Set Dst = Dst.Worksheet.Range("A1")
-End Sub
-
-Sub BuildAreasStatus(wks_name As String)
-    Dim rSrc As Range
-    Dim rDst As Range
-    Dim i As Integer
-        
-    With ThisWorkbook
-        Set rDst = .Worksheets(wks_name).Range("A3")
-        i = 3
-        
-        .Application.ScreenUpdating = False
-
-' ��������� ������� ��� ��� ������ ����������
-        While rDst <> ""
-            rDst.Offset(0, 4).Formula = "=INDEX(Edge2Net!F1:$F$1500, MATCH($A" & i & ",Edge2Net!$A$1:$A$1500,0), 1)"
-            rDst.Offset(0, 5).Formula = "=INDEX(LineCom!F1:$F$1500, MATCH($A" & i & ",LineCom!$A$1:$A$1500,0), 1)"
-            rDst.Offset(0, 6).Formula = "=INDEX(MTX!F1:$F$1500, MATCH($A" & i & ",MTX!$A$1:$A$1500,0), 1)"
-            rDst.Offset(0, 7).Formula = "=INDEX(Elcatel!F1:$F$1500, MATCH($A" & i & ",Elcatel!$A$1:$A$1500,0), 1)"
-            rDst.Offset(0, 8).Formula = "=INDEX(MC_MTT!F1:$F$1500, MATCH($A" & i & ",MC_MTT!$A$1:$A$1500,0), 1)"
-            rDst.Offset(0, 9).Formula = "=INDEX(Nova!F1:$F$1500, MATCH($A" & i & ",Nova!$A$1:$A$1500,0), 1)"
-            
-            i = i + 1
-            Set rDst = rDst.Offset(1, 0)
-        Wend
-        
-' ������������ �������� ���
-        Dim AreaCount As Integer
-
-        AreaCount = 3
-        Set rDst = .Worksheets(wks_name).Range("A3")
-        While rDst <> ""
-            Set rDst = rDst.Offset(1, 0)
-            AreaCount = AreaCount + 1
-        Wend
-
-        With .Worksheets(wks_name)
-            Set rDst = .Range(.Cells(3, 1), .Cells(AreaCount, 1))
-        End With
-
-        AreaCount = 3
-        Set rSrc = .Worksheets(WKS_FIX_AREAS_NAME).Range("A3")
-        While rSrc <> ""
-            Set rSrc = rSrc.Offset(1, 0)
-            AreaCount = AreaCount + 1
-        Wend
-
-        With .Worksheets(WKS_FIX_AREAS_NAME)
-            Set rSrc = .Range(.Cells(2, 1), .Cells(AreaCount, 1))
-        End With
-
-        Dim b As Range
-        Dim c As Range
-
-        For Each c In rDst
-            Set b = rSrc.Find(c, LookIn:=xlValues, MatchByte:=True)
-            If Not b Is Nothing Then
-                If c.Offset(0, 2) <> b.Offset(0, 2) Then
-                    c.Offset(0, 2) = b.Offset(0, 2)
-                    c.Offset(0, 3) = "Fixed"
-                    With .Worksheets(wks_name).Range(c.Offset(0, 0), c.Offset(0, 3))
-                        .Font.Bold = True
-                        .Font.ColorIndex = xlColorIndexAutomatic
-                    End With
-                Else
-                    c.Offset(0, 3) = "-"
-                End If
-            Else
-                Dim FixedList As Range
-                c.Offset(0, 3) = "New"
-                With .Worksheets(wks_name).Range(c.Offset(0, 0), c.Offset(0, 3))
-                    .Font.Bold = True
-                    .Font.ColorIndex = 3 ' Red
-                End With
-                
-'                Set Fixed
-            End If
-        Next c
-        
-        Application.ScreenUpdating = True
-        
-    End With
-End Sub
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Sub ClearWorkArea(DstName As String)
-    Dim DstRange As Range
-    With ThisWorkbook
-       
-        Set DstRange = .Worksheets(DstName).Range("A3")
-        Worksheets(DstName).Select
-        DstRange.Select
-        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
-        Range(Selection, Selection.End(xlDown)).Select
-        Selection.Delete Shift:=xlUp
-        Selection.Font.Bold = False
-        Selection.Font.ColorIndex = xlColorIndexAutomatic
-        Set DstRange = .Worksheets(DstName).Range("A3")
-        DstRange.Select
-    End With
-End Sub
-
-Function SheetExist(SheetName As String) As Boolean
-    Dim Count, i As Integer
-
-    Count = ThisWorkbook.Sheets.Count
-    SheetExist = False
-    For i = 1 To Count
-        If ThisWorkbook.Sheets(i).Name = SheetName Then
-            SheetExist = True
-            i = Count
-        End If
-    Next i
-End Function
-
-Function GetLinesCount(r As Range) As Integer
-
-    Dim LinesCount As Integer
-    LinesCount = 0
-
-    While r <> ""
-        LinesCount = LinesCount + 1
-        Set r = r.Offset(1, 0)
-    Wend
-    
-    GetLinesCount = LinesCount
-End Function
-
-Sub CreateSheet(wks_name As String)
-    Dim theRange As Range
-    With ThisWorkbook
-        If Not SheetExist(wks_name) Then
-            .Sheets.Add.Name = wks_name
-        End If
-            
-        .Sheets(wks_name).Visible = True
-        .Sheets(wks_name).Select
-        Cells.Select
-        Selection.ClearContents
-        Selection.Interior.ColorIndex = xlNone
-        Selection.Borders(xlLeft).LineStyle = xlNone
-        Selection.Borders(xlRight).LineStyle = xlNone
-        Selection.Borders(xlTop).LineStyle = xlNone
-        Selection.Borders(xlBottom).LineStyle = xlNone
-        Selection.BorderAround LineStyle:=xlNone
-        Selection.Font.ColorIndex = 0
-        Selection.EntireColumn.ColumnWidth = ActiveSheet.StandardWidth
-    
-        With .Worksheets(wks_name)
-            .Range("a1") = wks_name
-            .Range("a2") = "sCode"
-            .Range("b2") = "Code"
-            .Range("c2") = "Description"
-            .Range("d2") = "Price"
-            .Range("e2") = "Traffic"
-            .Range("f2") = "Status"
-            .Range("g2") = "Price2"
-            With .Range("a2:f2")
-                .Font.Bold = False
-                .WrapText = False
-                .HorizontalAlignment = xlCenter
-            End With
-            .Range("A1").Select
-        End With
-    End With
-End Sub
-
-Function GetGlobalAreaIdx(wks_name As String, AreaCount As Integer, scDst, scSrc) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim Answer As Integer
-    
-    GetGlobalAreaIdx = -1
-    
-    With ThisWorkbook.Worksheets(wks_name)
-        For i = Len(scSrc) To 1 Step -1
-            s = Left(scSrc, i)
-            If InStr(scDst, s) And i > 1 Then
-                Answer = FindVIndex(.Range("A:A"), AreaCount, s)
-                If Answer > 0 Then
-                    GetGlobalAreaIdx = Answer
-                    Exit Function
-                End If
-            End If
-        Next i
-    End With
-End Function
-
-
-Function FindVIndex(Src As Range, AreaCount As Integer, s As String) As Integer
-    Dim l As Long
-    FindVIndex = -1
-    For l = 1 To AreaCount
-        If s = Src.Cells(l, 1) Then
-            FindVIndex = l
-            Exit Function
-        End If
-    Next l
-End Function
-
-
-<<<<<<
-======================
-Constatnts
->>>>>>
-Attribute VB_Name = "Constatnts"
-Option Explicit
-
-Public Const UNKNOWN_AREA As String = "UNKNOWN_AREA"
-Public Const WKS_AREAS_NAME As String = "GlobalList"
-Public Const WKS_PRICE_NAME As String = "OpPrices"
-Public Const WKS_TRAFFIC_NAME As String = "OpTraffic"
-Public Const WKS_FIX_AREAS_NAME As String = "GLFixed"
-Public Const WKS_HOME_NAME As String = "Home"
-
-
-
-Sub AnalyzePrices()
-    AnalyzeOpPricesData WKS_PRICE_NAME, "0.0000"
-End Sub
-
-
-Sub AnalyzeData()
-    AnalyzeOpPricesData WKS_TRAFFIC_NAME, "0."
-End Sub
-
-<<<<<<
-======================
-ForecastPrice
->>>>>>
-Attribute VB_Name = "ForecastPrice"
-Option Explicit
-
-Sub ForecastBlankCodes()
-    Dim ListsRange As Range
-    Dim i As Integer
-    Dim AreaCount As Integer
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets(WKS_HOME_NAME).Range("OpList")
-        
-        Dim s As String
-        Dim r As Range
-        
-        AreaCount = 0
-        Set r = .Worksheets(WKS_PRICE_NAME).Range("A3")
-        While r <> ""
-            AreaCount = AreaCount + 1
-            Set r = r.Offset(1, 0)
-        Wend
-
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            Set r = .Worksheets(WKS_PRICE_NAME).Range("D2:I2").Find(s, LookIn:=xlValues, MatchByte:=True).Offset(1, 0)
-            DoForecast r, AreaCount
-        Next i
-    End With
-End Sub
-
-
-Sub DoForecast(Src As Range, AreaCount As Integer)
-    Dim i As Integer
-    Dim Dst As Range
-    Dim scSrc As String
-    Dim scDst As String
-    
-    Static PriceAvailable As Boolean
-    
-    With ThisWorkbook
-        Set Dst = Src.Offset(1, 0)
-    
-        If Application.WorksheetFunction.IsNumber(Src) = False Then
-            Src = "-"
-            Src.Font.Bold = True
-            Src.Font.ColorIndex = xlColorIndexAutomatic
-        End If
-        
-        For i = 1 To AreaCount
-            PriceAvailable = Application.WorksheetFunction.IsNumber(Dst)
-            
-            If PriceAvailable = True Then
-                Set Src = Dst
-                Set Dst = Src.Offset(1, 0)
-            Else
-                scSrc = .Worksheets(WKS_PRICE_NAME).Range("A:A").Cells(Src.Row, 1)
-                scDst = .Worksheets(WKS_PRICE_NAME).Range("A:A").Cells(Dst.Row, 1)
-                
-                Dim idx As Integer
-                
-                idx = GetGlobalAreaIdx(WKS_AREAS_NAME, AreaCount, scDst, scSrc)
-                If idx <> -1 Then
-                    Set Src = .Worksheets(WKS_PRICE_NAME).Cells(idx, Src.Column)
-                    
-                    Dst = Src
-                    Dst.Font.Bold = False
-                    Dst.Font.ColorIndex = 29 ' magenta
-                    Set Dst = Dst.Offset(1, 0)
-                Else
-                    Dst = "-"
-                    Dst.Font.ColorIndex = xlColorIndexAutomatic
-                    Dst.Font.Bold = True
-                    Set Dst = Dst.Offset(1, 0)
-                End If
-            End If
-        Next i
-    End With
-End Sub
-
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-Sub CalcCommonArea()
-    Dim SrcRange As Range
-    Dim DstRange As Range
-    Dim ListsRange As Range
-    
-    With ThisWorkbook
-        Set ListsRange = .Worksheets("Setup").Range("OpList")
-        
-        Dim s As String
-        Dim i As Integer
-        
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            Set DstRange = .Worksheets("Common").Range("A3")
-            Set SrcRange = .Worksheets(s).Range("A3")
-        
-            AddOpArea DstRange, SrcRange, i
-        Next i
-        Set SrcRange = .Worksheets("Common").Range("A3")
-        
-        Dim AreaCount As Integer
-        AreaCount = 0
-        
-        While SrcRange <> ""
-            AreaCount = AreaCount + 1
-            Set SrcRange = SrcRange.Offset(1, 0)
-        Wend
-        
-        For i = 1 To ListsRange.Count
-            s = ListsRange.Cells(i, 1).Value
-            DoOptimize s, AreaCount
-        Next i
-    End With
-End Sub
-
-Sub AddOpArea(Dst As Range, Src As Range, index As Integer)
-    While Src <> ""
-        If Dst > Src Then
-            Dst.Worksheet.Range(Dst, Dst.Offset(0, 50)).Insert Shift:=xlShiftDown
-            Set Dst = Dst.Offset(-1, 0)
-        End If
-        If Dst = "" Then
-            Dst = Src
-            Dst.Offset(0, 1) = Src.Offset(0, 1)
-            Dst.Offset(0, 2) = Src.Offset(0, 2)
-        End If
-        If Dst = Src Then
-            Dst.Offset(0, 2 + index) = Src.Offset(0, 3)
-            Set Src = Src.Offset(1, 0)
-        End If
-        Set Dst = Dst.Offset(1, 0)
-    Wend
-End Sub
-
-Sub DoOptimize(SrcName As String, AreaCount As Integer)
-    Dim i As Integer
-    Dim Src As Range
-    Dim Dst As Range
-    Dim scSrc As String
-    Dim scDst As String
-    
-    Static PriceAvailable As Boolean
-    
-    With ThisWorkbook
-        Set Src = .Worksheets("Common").Range(SrcName).Cells(1, 1)
-        Set Dst = Src.Offset(1, 0)
-    
-        For i = 1 To AreaCount
-            PriceAvailable = Application.WorksheetFunction.IsNumber(Dst)
-            
-            If PriceAvailable = True Then
-                Set Src = Dst
-                Set Dst = Src.Offset(1, 0)
-            Else
-                scSrc = .Worksheets("Common").Range("A:A").Cells(Src.Row, 1)
-                scDst = .Worksheets("Common").Range("A:A").Cells(Dst.Row, 1)
-                
-                Dim idx As Integer
-                
-                idx = GetGlobalAreaIdx(scDst, scSrc)
-                
-                Set Src = .Worksheets("Common").Range(SrcName).Cells(idx, 1)
-                
-                Dst = Src
-                Set Dst = Dst.Offset(1, 0)
-            End If
-        Next i
-    End With
-End Sub
-
-Function GetGlobalAreaIdx(scDst, scSrc) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim Answer As Integer
-    
-    GetGlobalAreaIdx = -1
-    
-    With ThisWorkbook.Worksheets("Common")
-        For i = Len(scSrc) To 1 Step -1
-            s = Left(scSrc, i)
-            If InStr(scDst, s) And i > 1 Then
-                Answer = FindVIndex(.Range("sCode"), s)
-                If Answer > 0 Then
-                    GetGlobalAreaIdx = Answer
-                    Exit Function
-                End If
-            End If
-        Next i
-    End With
-End Function
-
-
-Function FindVIndex(Src As Range, s As String) As Integer
-    Dim l As Long
-    FindVIndex = -1
-    For l = 1 To Src.Count
-        If s = Src.Cells(l, 1) Then
-            FindVIndex = l
-            Exit Function
-        End If
-    Next l
-End Function
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Option Explicit
-
-Type PriceRecord
-    Aria As String
-    Description As String
-    Description2 As String
-    Price As Double
-End Type
-
-Dim SourcePrData() As PriceRecord
-
-Sub a()
-    ReDim SourcePrData(1 To 5)
-    Erase SourcePrData
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-AppEv_ISP
->>>>>>
-Attribute VB_Name = "AppEv_ISP"
-
-
-Sub dummy()
-Attribute dummy.VB_ProcData.VB_Invoke_Func = " \n14"
-
-End Sub
-
-Sub Set_Default_Hosting()
-Attribute Set_Default_Hosting.VB_ProcData.VB_Invoke_Func = " \n14"
-    With ThisWorkbook.Worksheets("Prices.Hosting")
-        .Range("C5") = 1
-        .Range("c18") = 1
-        .Range("c23") = 1
-    End With
-End Sub
-
-Sub Set_Default_Intel()
-Attribute Set_Default_Intel.VB_ProcData.VB_Invoke_Func = " \n14"
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            .Range("b9") = 1
-            .Range("f15") = 1
-            .Range("b21") = 1
-            .Range("b30") = 1
-            .Range("b37") = 1
-            .Range("b45") = 1
-            .Range("b51") = 1
-            .Range("b57") = 1
-        Else
-            .Range("f9") = 1
-            .Range("f15") = 1
-            .Range("f21") = 1
-            .Range("f30") = 1
-            .Range("f37") = 1
-            .Range("f45") = 1
-            .Range("f51") = 1
-            .Range("f57") = 1
-        End If
-    End With
-
-End Sub
-
-Sub evISP_ModelChange()
-Attribute evISP_ModelChange.VB_ProcData.VB_Invoke_Func = " \n14"
-    SetCPUList
-    SetRAMList
-    SetHDDList
-    SetADDList
-    Set_Default_Intel
-End Sub
-
-Sub SetCPUList()
-Attribute SetCPUList.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim NewCbxRange, NewCbxIndex As String
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b10:b12").Address
-            NewCbxIndex = .Name & "!" & .Range("b9").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f10:f11").Address
-            NewCbxIndex = .Name & "!" & .Range("f9").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_CPU")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b16:b16").Address
-            NewCbxIndex = .Name & "!" & .Range("b15").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f16:f17").Address
-            NewCbxIndex = .Name & "!" & .Range("f15").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_CPU_CNT")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-End Sub
-
-Sub SetRAMList()
-Attribute SetRAMList.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim NewCbxRange, NewCbxIndex As String
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b22:b26").Address
-            NewCbxIndex = .Name & "!" & .Range("b21").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f22:f26").Address
-            NewCbxIndex = .Name & "!" & .Range("f21").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_RAM")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-End Sub
-
-Sub SetHDDList()
-Attribute SetHDDList.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim NewCbxRange, NewCbxIndex As String
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b31:b33").Address
-            NewCbxIndex = .Name & "!" & .Range("b30").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f31:f33").Address
-            NewCbxIndex = .Name & "!" & .Range("f30").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_HDD")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b38:b39").Address
-            NewCbxIndex = .Name & "!" & .Range("b37").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f38:f41").Address
-            NewCbxIndex = .Name & "!" & .Range("f37").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_HDD_CNT")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-End Sub
-
-Sub SetADDList()
-Attribute SetADDList.VB_ProcData.VB_Invoke_Func = " \n14"
-    Dim NewCbxRange, NewCbxIndex As String
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b46:b47").Address
-            NewCbxIndex = .Name & "!" & .Range("b45").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f46:f47").Address
-            NewCbxIndex = .Name & "!" & .Range("f45").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_CDRW")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b52:b53").Address
-            NewCbxIndex = .Name & "!" & .Range("b51").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f52:f52").Address
-            NewCbxIndex = .Name & "!" & .Range("f51").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_SVGA")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-    With ThisWorkbook.Worksheets("Prices.Intel")
-        If .Range("B3") = 1 Then ' ISP 1100
-            NewCbxRange = .Name & "!" & .Range("b58:b59").Address
-            NewCbxIndex = .Name & "!" & .Range("b57").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("f58:f59").Address
-            NewCbxIndex = .Name & "!" & .Range("f57").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Intel-ISP").Shapes("ISP_ETH2")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-End Sub
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-AppEv_ISP1100
->>>>>>
-Attribute VB_Name = "AppEv_ISP1100"
-Const PRICES_ISP1100 As String = "Prices.ISP1100"
-Const CALC_INTEL As String = "Calc.Intel"
-
-Sub dummy()
-Attribute dummy.VB_ProcData.VB_Invoke_Func = " \n14"
-
-End Sub
-
-
-
-Sub Set_Default_Intel_1100()
-Attribute Set_Default_Intel_1100.VB_ProcData.VB_Invoke_Func = " \n14"
-    With ThisWorkbook.Worksheets(PRICES_ISP1100)
-        .Range("b6") = 1
-        .Range("b11") = 1
-        .Range("f17") = 1
-        .Range("b23") = 1
-        .Range("b32") = 1
-        .Range("b39") = 1
-        .Range("b47") = 1
-        .Range("b52") = 1
-        .Range("b58") = 1
-        .Range("b64") = 1
-    End With
-End Sub
-<<<<<<
-======================
-AppEv_Hosting
->>>>>>
-Attribute VB_Name = "AppEv_Hosting"
-Const PRICES_HOSTING As String = "Prices.Hosting"
-
-Sub Set_Default_Hosting()
-Attribute Set_Default_Hosting.VB_ProcData.VB_Invoke_Func = " \n14"
-    With ThisWorkbook.Worksheets(PRICES_HOSTING)
-        .Range("C5") = 1
-        .Range("c18") = 1
-        .Range("c23") = 1
-    End With
-End Sub
-<<<<<<
-======================
-AppEv_ISP2150G
->>>>>>
-Attribute VB_Name = "AppEv_ISP2150G"
-Sub Set_Default_Intel_2150()
-Attribute Set_Default_Intel_2150.VB_ProcData.VB_Invoke_Func = " \n14"
-    With ThisWorkbook.Worksheets(PRICES_INTEL)
-        If .Range("B3") = 1 Then ' ISP 1100
-            .Range("b9") = 1
-            .Range("f15") = 1
-            .Range("b21") = 1
-            .Range("b30") = 1
-            .Range("b37") = 1
-            .Range("b45") = 1
-            .Range("b51") = 1
-            .Range("b57") = 1
-            .Range("j15") = 1
-        Else
-            .Range("f9") = 1
-            .Range("f15") = 1
-            .Range("f21") = 1
-            .Range("f30") = 1
-            .Range("f37") = 1
-            .Range("f45") = 1
-            .Range("f51") = 1
-            .Range("f57") = 1
-            .Range("j15") = 1
-        End If
-    End With
-
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag lengthProject Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-'    MsgBox "��� ���������� ������ ���������������� ������ ����������� ����� ������ 'CLOSE Demo' � ������ ������� ���� ����� ��������."
-'    Application.WindowState = xlMaximized
-'    SetEnvironment ThisWorkbook
-    GotoHome
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-AppEvents
->>>>>>
-Attribute VB_Name = "AppEvents"
-Sub dummy()
-
-End Sub
-
-Sub evRaQModelChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewCbxIndex As String
-    With ThisWorkbook.Worksheets("Data")
-        If .Range("B18") = 1 Then ' RaQ 2
-            NewCbxRange = .Name & "!" & .Range("E19:E21").Address
-            NewCbxIndex = .Name & "!" & .Range("E18").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("H19:H23").Address
-            NewCbxIndex = .Name & "!" & .Range("H18").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Dedication-RAQ").Shapes("RaQ-RAM")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-End Sub
-
-
-Sub SetDefColo()
-    With ThisWorkbook.Worksheets("Colocation")
-        .Shapes("ColoSize").ControlFormat.ListIndex = 3
-        .Shapes("ColoIP").ControlFormat.ListIndex = 1
-        .Shapes("ColoBandwith").ControlFormat.ListIndex = 1
-        .Shapes("ColoEthType").ControlFormat.ListIndex = 1
-        .Shapes("Colo-PriDNS").ControlFormat.ListIndex = 1
-        .Shapes("Colo-SecDNS").ControlFormat.ListIndex = 1
-        .Shapes("ColoReset").ControlFormat.ListIndex = 1
-    End With
-End Sub
-
-Sub SetDefRaQ()
-    With ThisWorkbook.Worksheets("Dedication-RaQ")
-        .Shapes("RaQ-CPU").ControlFormat.ListIndex = 2
-        .Shapes("RaQ-RAM").ControlFormat.ListIndex = 1
-        .Shapes("RaQ-HDD").ControlFormat.ListIndex = 1
-        .Shapes("RaQ-IP").ControlFormat.ListIndex = 1
-        .Shapes("RaQ-Bandwith").ControlFormat.ListIndex = 1
-        .Shapes("RaQ-PriDNS").ControlFormat.ListIndex = 1
-        .Shapes("RaQ-SecDNS").ControlFormat.ListIndex = 1
-        .Shapes("RaQReset").ControlFormat.ListIndex = 1
-    End With
-End Sub
-
-Sub SetDefSUN()
-    With ThisWorkbook.Worksheets("Dedication-SUN")
-        .Shapes("Sun-CPU").ControlFormat.ListIndex = 2
-        .Shapes("Sun-RAM").ControlFormat.ListIndex = 1
-        .Shapes("Sun-HDD").ControlFormat.ListIndex = 1
-        .Shapes("Sun-IP").ControlFormat.ListIndex = 1
-        .Shapes("Sun-Bandwith").ControlFormat.ListIndex = 1
-        .Shapes("Sun-PriDNS").ControlFormat.ListIndex = 1
-        .Shapes("Sun-SecDNS").ControlFormat.ListIndex = 1
-        .Shapes("SunReset").ControlFormat.ListIndex = 1
-    End With
-End Sub
-
-Sub SetDefHosting()
-    With ThisWorkbook.Worksheets("Hosting")
-        .Shapes("HostingPlane").ControlFormat.ListIndex = 3
-        .Shapes("HostingHDD").ControlFormat.ListIndex = 1
-    End With
-End Sub
-
-Sub SetDefMail()
-    With ThisWorkbook.Worksheets("CorpMail")
-        .Shapes("MailPlane").ControlFormat.ListIndex = 3
-        .Shapes("MailSize").ControlFormat.ListIndex = 2
-        .Shapes("MailDesign").ControlFormat.ListIndex = 1
-        .Shapes("Mail-PriDNS").ControlFormat.ListIndex = 1
-        .Shapes("Mail-SecDNS").ControlFormat.ListIndex = 1
-    End With
-End Sub
-
-Sub GoToOrderColo()
-    ThisWorkbook.Sheets("Order-Colo").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcColo()
-    ThisWorkbook.Sheets("Colocation").Select
-    LocalUp
-End Sub
-
-Sub GoToOrderRaQ()
-    ThisWorkbook.Sheets("Order-RaQ").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcRaQ()
-    ThisWorkbook.Sheets("Dedication-RAQ").Select
-    LocalUp
-End Sub
-
-Sub GoToOrderSun()
-    ThisWorkbook.Sheets("Order-SUN").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcSun()
-    ThisWorkbook.Sheets("Dedication-SUN").Select
-    LocalUp
-End Sub
-
-Sub GoToOrderHosting()
-    ThisWorkbook.Sheets("Order-Hosting").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcHosting()
-    ThisWorkbook.Sheets("Hosting").Select
-    LocalUp
-End Sub
-
-Sub GoToOrderMail()
-    ThisWorkbook.Sheets("Order-Mail").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcMail()
-    ThisWorkbook.Sheets("CorpMail").Select
-    LocalUp
-End Sub
-
-Sub GoToOrderDomain()
-    ThisWorkbook.Sheets("Order-Mail").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcDomain()
-    ThisWorkbook.Sheets("CorpMail").Select
-    LocalUp
-End Sub
-
-Sub GoToThanks()
-    ThisWorkbook.Sheets("Ok").Select
-    LocalUp
-End Sub
-
-Sub GotoHome()
-    ThisWorkbook.Sheets("LocalHome").Select
-    LocalUp
-End Sub
-
-Sub LocalUp()
-    Range("A1").Select
-End Sub
-
-Sub CloseDemo()
-'    RestoreEnvironment wb:=ThisWorkbook
-'    ThisWorkbook.Close SaveChanges:=False
-End Sub
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet61
->>>>>>
-Attribute VB_Name = "Sheet61"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet611
->>>>>>
-Attribute VB_Name = "Sheet611"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6111
->>>>>>
-Attribute VB_Name = "Sheet6111"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet61111
->>>>>>
-Attribute VB_Name = "Sheet61111"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-AppState
->>>>>>
-Attribute VB_Name = "AppState"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const PROGRAM_NAME = "E-Commerce ready Web Interface"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets("LocalHome").Select
-    End With
-'    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets("LocalHome").Select
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-'    DeleteCommandBar theApp:=Application
-End Sub
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Function ChkIncrease(aRange As Range) As Integer
-    Dim res As Integer
-    Dim areaCount As Long
-    areaCount = aRange.Count
-    res = 0
-    If areaCount > 1 Then
-        For i = 1 To areaCount - 1
-            If aRange(i).Value <= aRange(i + 1).Value Then
-                res = res + 1
-            End If
-        Next i
-    Else
-        res = -1
-    End If
-    
-    If (res = areaCount - 1) Then
-        ChkIncrease = 1
-    Else
-        ChkIncrease = 0
-    End If
-End Function
-
-Function ChkDecrease(aRange As Range) As Integer
-    Dim res As Integer
-    Dim areaCount As Long
-    areaCount = aRange.Count
-    res = 0
-    If areaCount > 1 Then
-        For i = 1 To areaCount - 1
-            If aRange(i).Value >= aRange(i + 1).Value Then
-                res = res + 1
-            End If
-        Next i
-    Else
-        res = -1
-    End If
-    
-    If (res = areaCount - 1) Then
-        ChkDecrease = 1
-    Else
-        ChkDecrease = 0
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-'    MsgBox "��� ���������� ������ ���������������� ������ ����������� ����� ������ 'CLOSE Demo' � ������ ������� ���� ����� ��������."
-'    Application.WindowState = xlMaximized
-'    SetEnvironment ThisWorkbook
-    GotoHome
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-AppEvents
->>>>>>
-Attribute VB_Name = "AppEvents"
-Sub dummy()
-
-End Sub
-
-Sub evRaQModelChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewCbxIndex As String
-    With ThisWorkbook.Worksheets("Data")
-        If .Range("B18") = 1 Then ' RaQ 2
-            NewCbxRange = .Name & "!" & .Range("E19:E21").Address
-            NewCbxIndex = .Name & "!" & .Range("E18").Address
-        Else
-            NewCbxRange = .Name & "!" & .Range("H19:H23").Address
-            NewCbxIndex = .Name & "!" & .Range("H18").Address
-        End If
-    End With
-    With ThisWorkbook.Worksheets("Dedication-RAQ").Shapes("RaQ-RAM")
-        .ControlFormat.ListFillRange = NewCbxRange
-        .ControlFormat.LinkedCell = NewCbxIndex
-    End With
-End Sub
-
-
-Sub SetDefColo()
-    With ThisWorkbook.Worksheets("Colocation")
-        .Shapes("ColoSize").ControlFormat.ListIndex = 3
-        .Shapes("ColoIP").ControlFormat.ListIndex = 1
-        .Shapes("ColoBandwith").ControlFormat.ListIndex = 1
-        .Shapes("ColoEthType").ControlFormat.ListIndex = 1
-        .Shapes("Colo-PriDNS").ControlFormat.ListIndex = 1
-        .Shapes("Colo-SecDNS").ControlFormat.ListIndex = 1
-        .Shapes("ColoReset").ControlFormat.ListIndex = 1
-    End With
-End Sub
-
-Sub SetDefRaQ()
-    With ThisWorkbook.Worksheets("Dedication-RaQ")
-        .Shapes("RaQ-CPU").ControlFormat.ListIndex = 2
-        .Shapes("RaQ-RAM").ControlFormat.ListIndex = 1
-        .Shapes("RaQ-HDD").ControlFormat.ListIndex = 1
-        .Shapes("RaQ-IP").ControlFormat.ListIndex = 1
-        .Shapes("RaQ-Bandwith").ControlFormat.ListIndex = 1
-        .Shapes("RaQ-PriDNS").ControlFormat.ListIndex = 1
-        .Shapes("RaQ-SecDNS").ControlFormat.ListIndex = 1
-        .Shapes("RaQReset").ControlFormat.ListIndex = 1
-    End With
-End Sub
-
-Sub SetDefSUN()
-    With ThisWorkbook.Worksheets("Dedication-SUN")
-        .Shapes("Sun-CPU").ControlFormat.ListIndex = 2
-        .Shapes("Sun-RAM").ControlFormat.ListIndex = 1
-        .Shapes("Sun-HDD").ControlFormat.ListIndex = 1
-        .Shapes("Sun-IP").ControlFormat.ListIndex = 1
-        .Shapes("Sun-Bandwith").ControlFormat.ListIndex = 1
-        .Shapes("Sun-PriDNS").ControlFormat.ListIndex = 1
-        .Shapes("Sun-SecDNS").ControlFormat.ListIndex = 1
-        .Shapes("SunReset").ControlFormat.ListIndex = 1
-    End With
-End Sub
-
-Sub SetDefHosting()
-    With ThisWorkbook.Worksheets("Hosting")
-        .Shapes("HostingPlane").ControlFormat.ListIndex = 3
-        .Shapes("HostingHDD").ControlFormat.ListIndex = 1
-    End With
-End Sub
-
-Sub SetDefMail()
-    With ThisWorkbook.Worksheets("CorpMail")
-        .Shapes("MailPlane").ControlFormat.ListIndex = 3
-        .Shapes("MailSize").ControlFormat.ListIndex = 2
-        .Shapes("MailDesign").ControlFormat.ListIndex = 1
-        .Shapes("Mail-PriDNS").ControlFormat.ListIndex = 1
-        .Shapes("Mail-SecDNS").ControlFormat.ListIndex = 1
-    End With
-End Sub
-
-Sub GoToOrderColo()
-    ThisWorkbook.Sheets("Order-Colo").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcColo()
-    ThisWorkbook.Sheets("Colocation").Select
-    LocalUp
-End Sub
-
-Sub GoToOrderRaQ()
-    ThisWorkbook.Sheets("Order-RaQ").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcRaQ()
-    ThisWorkbook.Sheets("Dedication-RAQ").Select
-    LocalUp
-End Sub
-
-Sub GoToOrderSun()
-    ThisWorkbook.Sheets("Order-SUN").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcSun()
-    ThisWorkbook.Sheets("Dedication-SUN").Select
-    LocalUp
-End Sub
-
-Sub GoToOrderHosting()
-    ThisWorkbook.Sheets("Order-Hosting").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcHosting()
-    ThisWorkbook.Sheets("Hosting").Select
-    LocalUp
-End Sub
-
-Sub GoToOrderMail()
-    ThisWorkbook.Sheets("Order-Mail").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcMail()
-    ThisWorkbook.Sheets("CorpMail").Select
-    LocalUp
-End Sub
-
-Sub GoToOrderDomain()
-    ThisWorkbook.Sheets("Order-Mail").Select
-    LocalUp
-End Sub
-
-Sub GoToCalcDomain()
-    ThisWorkbook.Sheets("CorpMail").Select
-    LocalUp
-End Sub
-
-Sub GoToThanks()
-    ThisWorkbook.Sheets("Ok").Select
-    LocalUp
-End Sub
-
-Sub GotoHome()
-    ThisWorkbook.Sheets("LocalHome").Select
-    LocalUp
-End Sub
-
-Sub LocalUp()
-    Range("A1").Select
-End Sub
-
-Sub CloseDemo()
-'    RestoreEnvironment wb:=ThisWorkbook
-'    ThisWorkbook.Close SaveChanges:=False
-End Sub
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet61
->>>>>>
-Attribute VB_Name = "Sheet61"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet611
->>>>>>
-Attribute VB_Name = "Sheet611"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6111
->>>>>>
-Attribute VB_Name = "Sheet6111"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet61111
->>>>>>
-Attribute VB_Name = "Sheet61111"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-AppState
->>>>>>
-Attribute VB_Name = "AppState"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const PROGRAM_NAME = "E-Commerce ready Web Interface"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets("LocalHome").Select
-    End With
-'    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets("LocalHome").Select
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-'    DeleteCommandBar theApp:=Application
-End Sub
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag lengthProject Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag lengthProject Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-<<<<<<
-Project Name : 'Denmark_method'
-Quirk - duff tag length======================
-MGetWebData
->>>>>>
-Attribute VB_Name = "MGetWebData"
-Option Explicit
-
-Const DATE_STAMP_OFFSET = PROJECT_IDX + 1
-Const TIME_STAMP_OFFSET = PROJECT_IDX + 4
-Const DATE_TIME_STAMP_SIZE = 5
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Const QueryDataName As String = "ExternalDenmarkData"
-
-Function UpdateHistory(wb As Workbook) As Boolean
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    UpdateHistory = False
-    QryPathStr = GetQryPath(wb)
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = IsNumeric(.Range("DEN_TIME"))
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table include temp area
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-    
-    '        .Parent.Application.DisplayAlerts = False
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-    '        .Parent.Application.DisplayAlerts = True
-            Dim i, j, row_idx As Integer
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).delete xlShiftUp
-            Else
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).delete xlShiftUp
-                End If
-            Else
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = "'" & Location.Cells(1 + row_idx, 1)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And TimeValue(Now) < TimeSerial(18, 0, 0)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistory = True
-End Function
-
-Private Function GetQryPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    Dim IsIntradai As Boolean
-    Dim DayCount As Integer
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/online/nph-single-old.cgi?"
-        QryPathStr = QryPathStr & "ticker=" & .Range("DEN_SYMBOL")
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        IsIntradai = IsNumeric(.Range("DEN_TIME"))
-        If IsIntradai Then
-            QryPathStr = QryPathStr & "&period=" & .Range("DEN_TIME")
-        Else
-            QryPathStr = QryPathStr & "&period=60"
-        End If
-        QryPathStr = QryPathStr & "&oh=11&ch=18"
-        QryPathStr = QryPathStr & "&separator=%2C"
-        QryPathStr = QryPathStr & "&vmode=Ignore&vtype=BA2"
-        QryPathStr = QryPathStr & "&format=Excel"
-        
-        If IsIntradai Then
-            DayCount = .Range("DEN_HISTORY") * .Range("DEN_TIME") \ 420 + 1 + .Range("DEN_HISTORY")
-        Else
-            DayCount = .Range("DEN_HISTORY")
-        End If
-        QryPathStr = QryPathStr & "&daysback=" & DayCount
-'        .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-    
-End Function
-
-Sub UpdateTickerList(wb As Workbook)
-    Dim Idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    QryPathStr = GetListPath(wb)
-    With wb
-        With .Worksheets(VAR_SHEET)
-            Idx = .Range("IDX_DEN_LIST")
-            Set Location = .Range("TICKER_TABLES").Offset(0, (Idx - 1) * 2)
-             .Range("IDX_DEN_SYMBOL") = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            ' Remove header
-            ' Find [DATA]
-            n = 0
-            Do While Location.Offset(n, 0) <> "[DATA]"
-                n = n + 1
-            Loop
-            .Range(Location.Offset(1, 0), Location.Offset(n, 1)).delete Shift:=xlUp
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-        
-        '        .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 0), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-        ' Setup Ticker List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        ' Setup Name List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Offset(0, 1).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-    End With
-End Sub
-
-Private Function GetListPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/names.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        QryPathStr = QryPathStr & "&category=STOCKS"
-        '.Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Application.ScreenUpdating = False
-    If Application.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        Shell "EXCEL " & wbname
-        ThisWorkbook.Close Savechanges:=False
-        Exit Sub
-    End If
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            ThisWorkbook.Save
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(FORM_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mReadWrite
->>>>>>
-Attribute VB_Name = "mReadWrite"
-Option Explicit
-
-Public Const GOOD_LINE_STATUS As String = "Ok"
-Public Const BAD_LINE_STATUS As String = "N/A"
-
-Function ReadWebData(Location As Range, Hist As Integer, dt As Integer, _
-              pPriceData As TPriceData) As Integer
-    '������������� ���� TPriceData �� ������� ���� - 1
-    'k��������� �� ����� ��� hist ��������� �����
-    'aPoint - ������ �������
-    '������ ��� ������ ������� �������������� ������ (������)
-    Dim n, i As Integer
-    
-    '����������� ����� ����� ������� - n
-    n = GetLinesCount(Location)
-    ReadWebData = n
-    If n < 9 Then             '���������� ������ !!!
-        GoTo done
-    End If
-    ' ����� ����� ���������� ()
-    If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-        Hist = (n - 3) \ dt + 1 '
-    End If
-    Dim t, s As Integer
-    For t = 0 To Hist - 1
-        s = n - t * dt - 1
-        pPriceData.D(Hist - t) = Location.Offset(s, DATE_IDX).Value
-        pPriceData.Tm(Hist - t) = Location.Offset(s, TIME_IDX).Value
-        pPriceData.Opn(Hist - t) = Location.Offset(s, OPEN_IDX).Value
-        pPriceData.Hgh(Hist - t) = Location.Offset(s, HIGH_IDX).Value
-        pPriceData.Lw(Hist - t) = Location.Offset(s, LOW_IDX).Value
-        pPriceData.Cls(Hist - t) = Location.Offset(s, CLOSE_IDX).Value
-        pPriceData.Vl(Hist - t) = Location.Offset(s, VOLUME_IDX).Value
-    Next t
-    ReadWebData = t + 1
-done:
-End Function
-
-Sub ResultLinesOut(Location As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim n As Integer
-    
-    n = GetLinesCount(Location)
-    With Location
-        .Offset(-1, RESIST_IDX) = "Resistance"
-        .Offset(-1, SUPPORT_IDX) = "Support"
-        .Offset(-1, PROJECT_IDX) = "Project"
-    End With
-    Dim t, count, Idx, loc_idx As Integer
-    count = pPD.tC
-    For t = 0 To count - 1
-        Idx = count - t
-        loc_idx = n - t - 1
-        If pDen.ResistanceLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, RESIST_IDX).Value = pDen.ResistanceLine(Idx)
-        End If
-        If pDen.SupportLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, SUPPORT_IDX).Value = pDen.SupportLine(Idx)
-        End If
-        If Abs(pDen.SignalValue) > 1 Then
-            Location.Offset(loc_idx, PROJECT_IDX).Value = pDen.ProjectPrice
-        End If
-    Next t
-End Sub
-
-Sub Out_Table_1(TheRange As Range, pDen As TDenmark, LastIdx As Integer)
-    
-    
-    ' Col = 2 - �� ��������� !!!
-    ' Status - Col = 0
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(0, 0).Value = BAD_LINE_STATUS
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(1, 0).Value = BAD_LINE_STATUS
-    End If
-    ' -----------------------------------------
-    ' ���� �������� ����� ������������� � ��������� - Col = 1
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 1).Value = pDen.ResistanceAngle
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 1).Value = pDen.SupportAngle
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 1).Value = (pDen.ResistanceAngle + pDen.SupportAngle) / 2
-    End If
-    ' -----------------------------------------
-    ' ������� ���� ����� �������� �� ������� ������
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 2).Value = pDen.ResistanceLine(LastIdx)
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 2).Value = pDen.SupportLine(LastIdx)
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 2).Value = _
-            (pDen.ResistanceLine(LastIdx) + pDen.SupportLine(LastIdx)) / 2
-    End If
-    
-End Sub
-
-Sub Out_Table_2(TheRange As Range, TheComment As Range, pPD As TPriceData, pDen As TDenmark)
-    Const ColorIndexBUY = 5
-    Const ColorIndexSELL = 3
-    Const ColorIndexNOTHINK = 14
-    
-    Dim SignalValue_defined, allert_enable  As Boolean
-    Dim Message As String
-    SignalValue_defined = False
-    allert_enable = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_ALLERT_DLG")
-    Message = "������ �� ��������� ������ �� ���������������."
-    If pDen.SignalValue >= 2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "BUY"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexBUY
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue - 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "BUY Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & pDen.SignalValue - 1 & " ! "
-    End If
-    If pDen.SignalValue <= -2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "SELL"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexSELL
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue + 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "SELL Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(pDen.SignalValue + 1) & "!"
-    End If
-    With TheComment
-        .Value = Message
-        .Font.Bold = True
-        Dim color_idx As Integer
-        If SignalValue_defined Then
-            If pDen.SignalValue > 0 Then
-                .Font.ColorIndex = ColorIndexBUY
-            Else
-                .Font.ColorIndex = ColorIndexSELL
-            End If
-        Else
-            .Font.ColorIndex = ColorIndexNOTHINK
-        End If
-    End With
-    If allert_enable And SignalValue_defined Then
-        MsgBox _
-            Prompt:=Message, _
-            Title:=PROGRAM_NAME, _
-            Buttons:=vbOKOnly + vbInformation
-    End If
-End Sub
-
-Sub Out_Table_3(TheRange As Range, pDen As TDenmark)
-    Dim i As Integer
-    For i = 1 To 3
-        TheRange.Offset(i - 1, 0).Value = pDen.Qualificator(i)
-    Next i
-End Sub
-
-Sub Out_Table_4(TheRange As Range, pPD As TPriceData)
-    Dim LastIdx As Integer
-    LastIdx = pPD.tC
-    With TheRange
-        .Offset(0, 0).Value2 = "'" & pPD.D(LastIdx)
-        .Offset(0, 1).Value2 = "'" & pPD.Tm(LastIdx)
-        .Offset(0, 2) = pPD.Opn(LastIdx)
-        .Offset(0, 3) = pPD.Hgh(LastIdx)
-        .Offset(0, 4) = pPD.Lw(LastIdx)
-        .Offset(0, 5) = pPD.Cls(LastIdx)
-        .Offset(0, 6) = pPD.Cls(LastIdx) - pPD.Cls(LastIdx - 1)
-    End With
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Denmark method bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-    End With
-    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(wb As Workbook)
-    With wb
-        .Application.ScreenUpdating = False
-        
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(FORM_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-            .Select
-        End With
-        With .Worksheets(CHART_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-        End With
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(wb As Workbook)
-    With wb
-        .Unprotect
-        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Unprotect
-        End With
-        With .Worksheets(FORM_SHEET)
-            .Select
-            .Unprotect
-        End With
-        .Application.ScreenUpdating = True
-        
-    End With
-End Sub
-
-<<<<<<
-======================
-mTypes
->>>>>>
-Attribute VB_Name = "mTypes"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "����� �-�� �������"
-Public Const PROGRAM_VERSION As String = "version 1.5 Professional"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-'Public Const ESTIMATION_DATE As Long = 19980915
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "J27"
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const PRICE_TABLE As String = "B1"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-Public Const VAR_SHEET As String = "Var_s"
-
-Public Const CHART_SHEET As String = "Chart"
-
-Public Const MIN_PRICE_VALUE As Double = 0.000001
-Public Const MAX_PRICE_VALUE As Double = 1000000000
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const CLOSE_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const HIGH_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const RESIST_IDX As Integer = 7
-Public Const SUPPORT_IDX As Integer = 8
-Public Const PROJECT_IDX As Integer = 9
-
-Type TPriceData
-    D() As String      ' ����������� ����
-    Tm() As String     ' �����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Double     ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type TDenmark
-   ResistanceLine() As Double           'Resistance line
-   ResistancePoints() As Integer        'Resistance pivot points
-   ResistancePointCount As Integer      'The number of resistance pivot points
-   ResistanceAngle As Double            'Angle of Declination of ResistanceLine
-   
-   SupportLine() As Double              'Support line
-   SupportPoints() As Integer           'Support pivot points
-   SupportPointsCount As Integer        'The number of support pivot points
-   SupportAngle As Double               ' Angle of Declination of SupportLine
-   
-   SignalParameter     As Integer       ' parameter for SignalValue
-   SignalValue      As Integer          'SignalValue
-   
-   
-   Qualificator(1 To 3) As String       ' qualificators
- 
-   ProjectNumber As Integer             ' ����� ��������
-   ProjectPrice  As Double              ' �������� ����
-   
-End Type
-
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-Dim AppRunEnable As New cEnableRun
-
-Sub evParamChange()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DENMARK_READY") = False
-End Sub
-
-Sub cmViewChart(Optional SwapPage As Boolean = True)
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_CHART_READY") = False
-        If .Range("BOOL_DENMARK_READY") <> True Then
-            If .Range("BOOL_AUTORECALC") = True Then
-                evSubmit_Click
-                If .Range("BOOL_DENMARK_READY") <> True Then
-                    Exit Sub
-                End If
-            Else
-                MsgBox _
-                    "������ �� ����� ���� ��������." & vbCrLf & "�������� ������ �� ����������.", _
-                    vbOKOnly + vbExclamation, _
-                    PROGRAM_NAME
-                Exit Sub
-            End If
-        End If
-    End With
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        With .Range("TABLE_1")
-            Dim test_lines As Boolean
-            test_lines = StrComp(.Cells(1, 1).Value, GOOD_LINE_STATUS)
-            test_lines = test_lines + StrComp(.Cells(2, 1).Value, GOOD_LINE_STATUS)
-            If test_lines <> 0 Then
-                MsgBox _
-                    Prompt:="������ �� ����� ���� ��������." & vbCrLf & "������� ����� �� ���������� .", _
-                    Title:=PROGRAM_NAME, _
-                    Buttons:=vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End With
-        Draw_Chart Not IsEmpty(.Range("TABLE_2").Cells(1, 1))
-    End With
-    With ThisWorkbook
-        .Worksheets(VAR_SHEET).Range("BOOL_CHART_READY") = True
-        If SwapPage Then
-            .Worksheets(CHART_SHEET).Select
-        End If
-    End With
-End Sub
-
-Sub cmViewForm()
-    With ThisWorkbook
-        .Worksheets(FORM_SHEET).Select
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Dim ResistanceLine
-    ResistanceLine = MsgBox( _
-        Prompt:="�� ������� ��������� ���������?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If ResistanceLine = vbYes Then
-       Application.Quit
-    End If
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Demark.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable wb:=ThisWorkbook
-    SetEnvironment wb:=ThisWorkbook
-    ProtectionEnable wb:=ThisWorkbook
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable wb:=ThisWorkbook
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=True
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmPrint()
-    If MsgBox( _
-            Prompt:="�� ������� ����������� ���������?", _
-            Buttons:=vbYesNo + vbQuestion, _
-            Title:=PROGRAM_NAME) = vbNo _
-    Then
-        Exit Sub
-    End If
-    Dim s_ticker, s_name, s_time As String
-    s_ticker = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME")
-    s_name = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_NAME")
-    s_time = Now
-    Application.ScreenUpdating = False
-    cmViewChart SwapPage:=False
-    Application.ScreenUpdating = False
-    With ThisWorkbook.Worksheets(FORM_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    With ThisWorkbook.Worksheets(CHART_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    Application.ScreenUpdating = False
-    ThisWorkbook.Worksheets(Array("MainForm", "Chart")).PrintOut Copies:=1, Collate:=True
-    cmViewForm
-End Sub
-<<<<<<
-======================
-mDemark
->>>>>>
-Attribute VB_Name = "mDemark"
-Option Explicit
-
-Public Const FORM_SHEET As String = "MainForm"
-
-'Form Ranges
-Public Const TABLE_1 As String = "TABLE_1"
-Public Const TABLE_2 As String = "TABLE_2"
-Public Const TABLE_3 As String = "TABLE_3"
-Public Const TABLE_4 As String = "TABLE_4"
-Public Const TABLE_COMMENT As String = "TABLE_COMMENT"
-
-'�������� ��� ������ - �������� 1
-
-'*********************
-Dim PriceDataArray As TPriceData
-Dim DenmarkDataArray As TDenmark
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Function TDenmark_Calc() As Boolean
-    
-    Dim nWindow As Integer
-    Dim bPrevCloseFilter, bSuccCloseFilter As Boolean
-    
-    TDenmark_Calc = False
-    
-    mobjAppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-'1)    Read User data
-        With .Worksheets(VAR_SHEET)
-            DenmarkDataArray.ProjectNumber = .Range("DEN_PROECT").Value
-            DenmarkDataArray.SignalParameter = .Range("DEN_PARAM").Value
-            nWindow = .Range("DEN_WINDOW").Value
-            bPrevCloseFilter = .Range("BOOL_PREV_CLOSE").Value
-            bSuccCloseFilter = .Range("BOOL_SUCC_CLOSE").Value
-        End With
-
-'2)   Memory allocation
-        allocate_memory PriceDataArray, DenmarkDataArray, nWindow
-
-'3)   Read data
-        Dim TheRange As Range
-        Set TheRange = .Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE)
-        Dim LinesCount As Integer
-        LinesCount = ReadWebData(Location:=TheRange, Hist:=PriceDataArray.tC, dt:=1, pPriceData:=PriceDataArray)
-        
-        'Init function result
-        TDenmark_Calc = LinesCount >= nWindow
-        
-        If LinesCount >= nWindow Then
-        
-'4)   Calculate metod TDenmarkDataArray
-            DetDenmark PriceDataArray, DenmarkDataArray, bPrevCloseFilter, bSuccCloseFilter
-            If Abs(DenmarkDataArray.SignalValue) > 1 Then  '������� ���������, ���� ���� ������
-                DetProj PriceDataArray, DenmarkDataArray
-            End If
-'5)   Write result
-            Application.ScreenUpdating = False
-    
-'6)    Clear interface tables
-            With .Worksheets(FORM_SHEET)
-                .Range(TABLE_1).ClearContents ' �������-1
-                .Range(TABLE_2).ClearContents ' �������-2
-                .Range(TABLE_3).ClearContents ' �������-3
-                .Range(TABLE_COMMENT).Value = "" ' ����������-3
-                .Range(TABLE_4).ClearContents ' �������-4
-            End With
-    
-            ResultLinesOut Location:=TheRange.Offset(2, 0), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-            
-            With .Worksheets(FORM_SHEET)
-                Out_Table_1 TheRange:=.Range(TABLE_1).Cells(1, 1), pDen:=DenmarkDataArray, LastIdx:=PriceDataArray.tC
-                Out_Table_2 _
-                        TheRange:=.Range(TABLE_2).Cells(1, 1), _
-                        TheComment:=.Range("TABLE_COMMENT"), _
-                        pPD:=PriceDataArray, _
-                        pDen:=DenmarkDataArray
-                Out_Table_3 TheRange:=.Range(TABLE_3).Cells(1, 1), pDen:=DenmarkDataArray
-                Out_Table_4 TheRange:=.Range(TABLE_4).Cells(1, 1), pPD:=PriceDataArray
-                With .Range(TABLE_1)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_2)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_3)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_4)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-            End With
-            .Worksheets(VAR_SHEET).Range("BOOL_DENMARK_READY") = True
-        Else
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            .Worksheets(VAR_SHEET).Range("BOOL_DENMARK_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-'7)   Free unused memory
-        free_unused_memory PriceDataArray, DenmarkDataArray
-    End With
-End Function
-
-Sub allocate_memory(pPriceData As TPriceData, pDenmarkData As TDenmark, memsize As Integer)
-'  ������ ��� TDenmark
-    ReDim pDenmarkData.ResistanceLine(1 To memsize)
-    ReDim pDenmarkData.ResistancePoints(1 To memsize)
-    ReDim pDenmarkData.SupportLine(1 To memsize)
-    ReDim pDenmarkData.SupportPoints(1 To memsize)
-   
-' ������������� ������ �� �����
-    pPriceData.tC = memsize
-    ReDim pPriceData.D(1 To memsize)
-    ReDim pPriceData.Tm(1 To memsize)
-    ReDim pPriceData.Opn(1 To memsize)
-    ReDim pPriceData.Hgh(1 To memsize)
-    ReDim pPriceData.Lw(1 To memsize)
-    ReDim pPriceData.Cls(1 To memsize)
-    ReDim pPriceData.Vl(1 To memsize)
-
-End Sub
-
-Sub free_unused_memory(pP As TPriceData, pD As TDenmark)
-'   Free Prices
-    pP.tC = 0
-    Erase pP.D
-    Erase pP.Tm
-    Erase pP.Opn
-    Erase pP.Hgh
-    Erase pP.Lw
-    Erase pP.Cls
-    Erase pP.Vl
-    
-'Free TDenmark
-    Erase pD.ResistanceLine
-    Erase pD.ResistancePoints
-    Erase pD.SupportLine
-    Erase pD.SupportPoints
-End Sub
-
-
-'*****************************************
-Sub DetDenmark(pPriceData As TPriceData, pDenmarkData As TDenmark, ByVal ClosePrev2 As Boolean, ByVal CloseSucc1 As Boolean)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPriceData  - ����, ����������� ����� ������ �� ����� (����������)
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' pDenmarkData - �������� ������ �������� (������ ��������, SignalParameter - ���������):
-' ����� ResistanceLine,SupportLine �� �������, ������� �����, ������� � ������� ��� �������
-' SignalValue = 0 ������ �����������
-' SignalValue < 0 ������ ����������� ������ (������ �������)
-' SignalValue > 0 ������ ����������� ������ (������ �������)
-' ���� pDenmarkData.ResistancePointCount < 2, �� �������� ResistanceLine �� ������������
-' ���� pDenmarkData.SupportPointsCount < 2, �� �������� SupportLine �� ������������
-
-' ��������� ���������
-    Const QUALIFICATOR_DISABLE As String = "-"
-    Const QUALIFICATOR_ENABLE As String = "Signal"
-    
-    Dim UpQual(1 To 3) As String
-    Dim DownQual(1 To 3) As String
-    Dim UpSignal, DownSignal As Integer
-    Dim i As Integer
-    
-    pDenmarkData.SignalValue = 0
-    UpSignal = 0
-    DownSignal = 0
-    
-    For i = 1 To 3
-        pDenmarkData.Qualificator(i) = QUALIFICATOR_DISABLE
-        UpQual(i) = QUALIFICATOR_DISABLE
-        DownQual(i) = QUALIFICATOR_DISABLE
-    Next i
-    
-' ����������� ����� ��������� � �������������
-    ResLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.ResistancePointCount, _
-        pDenmarkData.ResistanceLine, _
-        pDenmarkData.ResistancePoints, _
-        ClosePrev2, _
-        CloseSucc1
-        
-    SuppLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.SupportPointsCount, _
-        pDenmarkData.SupportLine, _
-        pDenmarkData.SupportPoints, _
-        ClosePrev2, _
-        CloseSucc1
-
-        
-        
-    If pDenmarkData.ResistancePointCount >= 2 Then
-        pDenmarkData.ResistanceAngle = 57.29578 * _
-            Atn(pDenmarkData.ResistanceLine(pPriceData.tC) - _
-                pDenmarkData.ResistanceLine(pPriceData.tC - 1))
-    End If
-    If pDenmarkData.SupportPointsCount >= 2 Then
-        pDenmarkData.SupportAngle = 57.29578 * _
-            Atn(pDenmarkData.SupportLine(pPriceData.tC) - _
-                pDenmarkData.SupportLine(pPriceData.tC - 1))
-    End If
-
-' ������������ ������� ----------------------------------
-    Dim t As Integer
-' 1. ������ ����������� ������: ResistanceLine ��������� � ResistanceLine ������ *************
-    If pDenmarkData.ResistancePointCount >= 2 And pDenmarkData.ResistanceAngle < 0 Then
-'    ����������� ������� ������� �����
-        If pDenmarkData.ResistanceLine(pPriceData.tC) < pPriceData.Cls(pPriceData.tC) Then
-            UpSignal = 1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) > pDenmarkData.ResistanceLine(t) Then
-                    UpSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If UpSignal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) > pPriceData.Cls(pPriceData.tC - 1) Then
-                UpSignal = UpSignal + 1
-                UpQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: open > ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) > pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - demand value < ResistanceLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Lw(pPriceData.tC - 1) < pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-    End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: SupportLine ��������� � SupportLine ������
-    If pDenmarkData.SupportPointsCount >= 2 And pDenmarkData.SupportAngle > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-        If pPriceData.Cls(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-            DownSignal = -1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) < pDenmarkData.SupportLine(t) Then
-                    DownSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If DownSignal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) < pPriceData.Cls(pPriceData.tC - 1) Then
-                DownSignal = DownSignal - 1
-                DownQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: Open ���� ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - supply value(t-1) > SupportLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Hgh(pPriceData.tC - 1) > pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-'    ---------------------------------------------
-    End If
-'      ���������� ������������ ���������
-    If Abs(DownSignal) <> UpSignal Then
-        If Abs(DownSignal) > UpSignal Then
-            pDenmarkData.SignalValue = DownSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = DownQual(i)
-            Next i
-        Else
-            pDenmarkData.SignalValue = UpSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = UpQual(i)
-            Next i
-        End If
-    End If
-End Sub
-
-Sub DetProj(pPriceData As TPriceData, pDenmarkData As TDenmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-    Dim pM As Double, t As Integer, Tm As Integer, tL As Integer
-
-    If pDenmarkData.SignalValue >= 2 Then  ' ������ �������
-
-        tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount)     ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2 Then
-'           t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < ResistanceLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Lw(Tm) ' L(t-1) < ResistanceLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Lw(t) < pM And pPriceData.Lw(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Lw(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
-'               P1( tb) = ResistanceLine(tb) + ResistanceLine(t*) - L(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Lw(Tm)
-            Else
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If ' pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < ResistanceLine(t)}
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Cls(t) < pM And pPriceData.Cls(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue >= 2
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-    If pDenmarkData.SignalValue <= -2 Then
-        tL = pDenmarkData.SupportPoints(pDenmarkData.SupportPointsCount)  ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.SupportPointsCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber = 1 Or pDenmarkData.ProjectNumber = 2 Then
-'           t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > SupportLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Hgh(Tm) ' H(t-1) > SupportLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Hgh(t) > pM And pPriceData.Hgh(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Hgh(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
- '              P1( tb) = SupportLine(tb) + SupportLine(t*) - H(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Hgh(Tm)
-            Else
-'               P2( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  SupportLine(t)}
-'           P3( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pM < pPriceData.Cls(t) And pPriceData.Cls(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue <= -2
-End Sub
-
-Sub ResLine(pP As TPriceData, tE As Integer, ResistancePointCount As Integer, _
-            ResistanceLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� ResistanceLine, dom(ResistanceLine)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(ResistancePointCount)}, s(1) < s(2) < ...< s(ResistancePointCount)
-'   ( s(ResistancePointCount)<= tE )- ������� �����
-' 3) ����� ������� ����� ResistancePointCount.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� SupportLine
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-  
-'1 ����������� ������� �������� �������
-    ResistancePointCount = 0
-    For t = 3 To tE - 1
- '      v = max{high(t-1), high(t+1)} < high(t)}
-        v = pP.Hgh(t - 1)
-        If v < pP.Hgh(t + 1) Then
-            v = pP.Hgh(t + 1)
-        End If
-        IsGoodPoint = pP.Hgh(t) > v
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) < pP.Hgh(t))
-        End If
-        
-        If IsGoodPoint Then       'alt.: v >= High(t + 1)
-            s(ResistancePointCount + 1) = t: ResistancePointCount = ResistancePointCount + 1
-        End If
-    Next t
-    
-loop_:
-    
-    If ResistancePointCount < 2 Then
-        GoTo done
-    End If
-
-' 2 ����������� ����� �������������
-    ResistanceLine(s(1)) = pP.Hgh(s(1))
-    For i = 2 To ResistancePointCount
-        ResistanceLine(s(i)) = pP.Hgh(s(i))
-        v = (pP.Hgh(s(i)) - pP.Hgh(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            ResistanceLine(t) = pP.Hgh(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(ResistancePointCount) < tE Then
-        v = (pP.Hgh(s(ResistancePointCount)) - pP.Hgh(s(ResistancePointCount - 1))) / (s(ResistancePointCount) - s(ResistancePointCount - 1))
-        For t = s(ResistancePointCount) + 1 To tE
-            ResistanceLine(t) = pP.Hgh(s(ResistancePointCount - 1)) + v * (t - s(ResistancePointCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To ResistancePointCount
-            If ResistanceLine(s(t) + 1) < pP.Cls(s(t) + 1) Then
-                ResistancePointCount = ResistancePointCount - 1
-                ' ������� �����
-                For i = t To ResistancePointCount
-                    s(i) = s(i + 1)
-                Next i
-                s(ResistancePointCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(ResistanceLine)
-                Rb = UBound(ResistanceLine)
-                Erase ResistanceLine
-                ReDim ResistanceLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-    
-done:
-End Sub
-
-Sub SuppLine(pP As TPriceData, tE As Integer, SupportPointsCount As Integer, _
-               SupportLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� SupportLine, dom(SupportLine)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(SupportPointsCount)}, s(1) < s(2) < ...< s(SupportPointsCount) -
-'    ������� �����
-' 3) ����� ������� ����� SupportPointsCount.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-    
-'1 ����������� ������� �������� �������
-     SupportPointsCount = 0
-    For t = 3 To tE - 1
-'       v = min{Low(t-1), Low(t+1)} > Low(t)
-        v = pP.Lw(t - 1)
-        If v > pP.Lw(t + 1) Then
-            v = pP.Lw(t + 1)
-        End If
-        
-        IsGoodPoint = pP.Lw(t) < v
-        
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) > pP.Lw(t))
-        End If
-        
-        If IsGoodPoint Then     'alt.: v >= High(t + 1)
-            s(SupportPointsCount + 1) = t: SupportPointsCount = SupportPointsCount + 1
-        End If
-    Next t
-
-loop_:
-    If SupportPointsCount < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� ���������
-    
-    SupportLine(s(1)) = pP.Lw(s(1))
-    For i = 2 To SupportPointsCount
-        SupportLine(s(i)) = pP.Lw(s(i))
-        v = (pP.Lw(s(i)) - pP.Lw(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            SupportLine(t) = pP.Lw(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(1) < tE Then
-        v = (pP.Lw(s(SupportPointsCount)) - pP.Lw(s(SupportPointsCount - 1))) / (s(SupportPointsCount) - s(SupportPointsCount - 1))
-        For t = s(SupportPointsCount) + 1 To tE
-            SupportLine(t) = pP.Lw(s(SupportPointsCount - 1)) + v * (t - s(SupportPointsCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To SupportPointsCount
-            If SupportLine(s(t) + 1) > pP.Cls(s(t) + 1) Then
-                SupportPointsCount = SupportPointsCount - 1
-                ' ������� �����
-                For i = t To SupportPointsCount
-                    s(i) = s(i + 1)
-                Next i
-                s(SupportPointsCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(SupportLine)
-                Rb = UBound(SupportLine)
-                Erase SupportLine
-                ReDim SupportLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-done:
-End Sub
-
-<<<<<<
-======================
-mChart
->>>>>>
-Attribute VB_Name = "mChart"
-Option Explicit
-
-Const CHART_NAME As String = "PriceChart"
-
-Sub Draw_Chart(SignalDefined As Boolean)
-
-    Dim n As Integer
-    Dim theChart As Chart
-    Dim ChartDataAria, szLastNumber As String
-    Dim MinYScale As Double
-    
-    
-    With ThisWorkbook
-' Checking data
-' Disable screen out
-        .Application.Cursor = xlWait
-        .Application.ScreenUpdating = False
-' Create series range
-        n = GetLinesCount(Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE))
-        szLastNumber = n + 1
-        If SignalDefined Then
-            ChartDataAria = "A2:A" + szLastNumber + ",D2:E" + szLastNumber + ",I2:K" + szLastNumber
-        Else
-            ChartDataAria = "A2:A" + szLastNumber + ",D2:E" + szLastNumber + ",I2:J" + szLastNumber
-        End If
-        MinYScale = GetMinValue(.Worksheets(RAW_DATA_SHEET).Range(ChartDataAria))
-' Find and delete old chart
-        .Worksheets(CHART_SHEET).Unprotect
-        Dim WindowWidth, WindowHeight As Integer
-        With .Worksheets(CHART_SHEET)
-            WindowWidth = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            WindowHeight = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-        
-        
-        With .Worksheets(CHART_SHEET).ChartObjects
-            .delete
-            With .Add(5, 5, WindowWidth - 10, WindowHeight - 10)
-                .SendToBack
-                Set theChart = .Chart
-            End With
-' Create a chart
-        End With
-        With theChart
-            .ChartType = xlLine
-            .SetSourceData Source:=Sheets(RAW_DATA_SHEET).Range( _
-                    ChartDataAria), PlotBy:=xlColumns
-            .Location Where:=xlLocationAsObject, name:=CHART_SHEET
-            .HasTitle = True
-            With .ChartTitle
-                .Text = ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE).Value
-                With .Font
-                    .Size = 8
-                    .Bold = True
-                End With
-            End With
-            .HasLegend = True
-            With .Legend
-                .Position = xlTop
-                With .Font
-                    .name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            .HasDataTable = False
-            With .Axes(xlCategory)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                .TickLabels.Orientation = xlUpward
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .CrossesAt = 1
-                .TickLabelSpacing = 1
-                .TickMarkSpacing = 1
-                .AxisBetweenCategories = False
-                .ReversePlotOrder = False
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            With .Axes(xlValue)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .MinimumScale = MinYScale
-                .MaximumScaleIsAuto = True
-                .MinorUnitIsAuto = True
-                .MajorUnitIsAuto = True
-                .Crosses = xlCustom
-                .CrossesAt = MinYScale
-                .ReversePlotOrder = False
-                .ScaleType = xlLinear
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            .ChartTitle.Top = 5
-            .ChartTitle.Left = 5
-            With .Legend
-                .Top = 5
-                .Fill.OneColorGradient _
-                    Style:=msoGradientHorizontal, _
-                    Variant:=3, _
-                    Degree:=0.303913939116503
-                .Fill.Visible = True
-                .Fill.ForeColor.SchemeColor = 71
-            End With
-            .PlotArea.Left = 10
-            .PlotArea.Top = .Legend.Top + .Legend.Height + 5
-            .PlotArea.Width = .ChartArea.Width - 20
-            .PlotArea.Height = .ChartArea.Height - .PlotArea.Top
-            
-' Tune OPEN line
-            With .SeriesCollection(1)
-                .Border.LineStyle = xlNone
-                .MarkerBackgroundColorIndex = xlNone
-                .MarkerForegroundColorIndex = 1
-                .MarkerStyle = xlPlus
-                .Smooth = False
-                .MarkerSize = 9
-                .Shadow = False
-            End With
-' Tune CLOSE line
-            With .SeriesCollection(2)
-                .Border.ColorIndex = 10
-                .Border.Weight = xlMedium
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune RESISTANCE line
-            With .SeriesCollection(3)
-                .Border.ColorIndex = 3
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune SUUPORT line
-            With .SeriesCollection(4)
-                .Border.ColorIndex = 25
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-            If SignalDefined Then
-                With .SeriesCollection(5)
-                    .Border.ColorIndex = 6
-                    .Border.Weight = xlThin
-                    .Border.LineStyle = xlDot
-                End With
-            End If
-        End With
-        .Application.Cursor = xlDefault
-        With .Worksheets(CHART_SHEET)
-            .Range("A1").Select
-            .Protect userInterfaceOnly:=True
-        End With
-    End With
-End Sub
-
-Function GetMinValue(DataRange As Range) As Double
-    Dim Cell As Range
-    Dim MinValue, MaxValue, RangeValue, CorrectValue, Mult As Double
-    MinValue = MAX_PRICE_VALUE
-    MaxValue = MIN_PRICE_VALUE
-    For Each Cell In DataRange
-        If Not IsEmpty(Cell) And IsNumeric(Cell) Then
-            If Cell > MIN_PRICE_VALUE Then
-                If Cell < MinValue Then
-                    MinValue = Cell
-                End If
-                If Cell > MaxValue Then
-                    MaxValue = Cell
-                End If
-            End If
-        End If
-    Next
-    RangeValue = MaxValue - MinValue
-    If RangeValue < 0 Then
-        MinValue = 0
-    Else
-        CorrectValue = RangeValue / 4
-        Mult = MIN_PRICE_VALUE
-        While MinValue - Int(MinValue * Mult) / Mult > CorrectValue
-            Mult = Mult * 10
-        Wend
-        MinValue = Int(MinValue * Mult) / Mult
-    End If
-    GetMinValue = MinValue
-End Function
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{00A1CC6B-8DDA-11D2-B34E-525400DB02FE}{00A1CC5A-8DDA-11D2-B34E-525400DB02FE}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mWebQeury
->>>>>>
-Attribute VB_Name = "mWebQeury"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.name = QryName Then
-            WebQuery.delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-Attribute CreateCommandBar.VB_ProcData.VB_Invoke_Func = "R\n14"
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Contents"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 49
-                        .OnAction = "cmHelpContents"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim curdate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    curdate = year * 10000
-    curdate = curdate + month * 100
-    curdate = curdate + day
-    If curdate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mTool
->>>>>>
-Attribute VB_Name = "mTool"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub tool_delete_all_tables()
-    QryDelete ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range("A1")
-End Sub
-
-Sub tool_delete_all_charts(theSheet As Worksheet)
-    Dim theChart As Chart
-    For Each theChart In theSheet
-        theChart.Unprotect
-        theChart.delete
-    Next
-End Sub
-
-Sub DateTimeTest()
-    Dim the_date
-    Dim the_time
-    the_date = DateValue(Now)
-    the_time = TimeValue(Now)
-End Sub
-
-
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{00A1CC67-8DDA-11D2-B34E-525400DB02FE}{00A1CC62-8DDA-11D2-B34E-525400DB02FE}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-
-
-Private Sub App_WorkbookOpen(ByVal wb As Workbook)
-    Dim wbname As String
-    If Application.Workbooks.count > 1 Then
-        wbname = wb.FullName
-        wb.Close Savechanges:=False
-        Shell "EXCEL " & wbname
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-mDataCommands
->>>>>>
-Attribute VB_Name = "mDataCommands"
-Option Explicit
-
-Sub evTicker_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SECNAME") = .Range("IDX_DEN_SYMBOL")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evSecName_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SYMBOL") = .Range("IDX_DEN_SECNAME")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evHistory_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_DATA_READY") = False
-    End With
-End Sub
-
-Sub evSubmit_Click()
-    Dim ticker As String
-
-    Application.Cursor = xlWait
-    Dim wb As Workbook
-    Set wb = ThisWorkbook
-    With wb
-        With .Worksheets(VAR_SHEET)
-            ticker = .Range("DEN_SYMBOL")
-            If .Range("BOOL_DATA_DOWNLOAD") = True Or .Range("BOOL_DATA_READY") = False Then
-                .Range("BOOL_DATA_READY") = UpdateHistory(wb)
-                .Range("BOOL_DENMARK_READY") = False
-            End If
-        End With
-        If TDenmark_Calc Then
-            With .Worksheets(FORM_SHEET)
-                .Range("CALC_TICKER_NAME") = ticker
-            End With
-        End If
-    End With
-    Application.Cursor = xlDefault
-    
-End Sub
-
-Sub evGroupChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        GroupIdx = .Range("IDX_DEN_LIST")
-        .Range("IDX_DEN_SYMBOL") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat.ListFillRange = NewCbxRange
-        NewRangeOffsetCol = NewRangeOffsetCol + 1
-        NewCbxRange = .name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat.ListFillRange = NewCbxRange
-    End With
-    evTicker_Change
-End Sub
-
-Sub evUpdateTickerList()
-    UpdateTickerList ThisWorkbook
-    evHistory_Change
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Vars
->>>>>>
-Attribute VB_Name = "Vars"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-RawData
->>>>>>
-Attribute VB_Name = "RawData"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mWebGetData
->>>>>>
-Attribute VB_Name = "mWebGetData"
-Option Explicit
-
-Const QueryDataName As String = "ExternalRBCData"
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Function UpdateHistory(wb As Workbook) As Boolean
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim HistoryWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    UpdateHistory = False
-    QryPathStr = GetQryPath(wb)
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            HistoryWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                HistoryWindow = HistoryWindow + 1
-            End If
-            IsIntraday = IsNumeric(.Range("DEN_TIME"))
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table include temp area
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.Count
-            End With
-    
-    '        .Parent.Application.DisplayAlerts = False
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-    '        .Parent.Application.DisplayAlerts = True
-            Dim i, j, row_idx As Integer
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + VOLUME_IDX) _
-            ).ClearContents
-            
-            If row_idx > HistoryWindow Then
-                row_idx = row_idx - HistoryWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + VOLUME_IDX) _
-                ).Delete xlShiftUp
-            Else
-                Exit Function
-            End If
-            
-            row_idx = HistoryWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(HistoryWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(HistoryWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(HistoryWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(HistoryWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(HistoryWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + VOLUME_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + VOLUME_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).Delete xlShiftUp
-                End If
-            Else
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = "'" & Location.Cells(1 + row_idx, 1)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And TimeValue(Now) < TimeSerial(18, 0, 0)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).Delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistory = True
-End Function
-
-Private Function GetQryPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    Dim IsIntradai As Boolean
-    Dim DayCount As Integer
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/online/nph-single-old.cgi?"
-        QryPathStr = QryPathStr & "ticker=" & .Range("DEN_SYMBOL")
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        IsIntradai = IsNumeric(.Range("DEN_TIME"))
-        If IsIntradai Then
-            QryPathStr = QryPathStr & "&period=" & .Range("DEN_TIME")
-        Else
-            QryPathStr = QryPathStr & "&period=60"
-        End If
-        QryPathStr = QryPathStr & "&oh=11&ch=18"
-        QryPathStr = QryPathStr & "&separator=%2C"
-        QryPathStr = QryPathStr & "&vmode=Ignore&vtype=BA2"
-        QryPathStr = QryPathStr & "&format=Excel"
-        
-        If IsIntradai Then
-            DayCount = .Range("DEN_HISTORY") * .Range("DEN_TIME") \ 420 + 1 + .Range("DEN_HISTORY")
-        Else
-            DayCount = .Range("DEN_HISTORY")
-        End If
-        QryPathStr = QryPathStr & "&daysback=" & DayCount
-'        .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-    
-End Function
-
-Sub UpdateTickerList(wb As Workbook)
-    Dim idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    QryPathStr = GetListPath(wb)
-    With wb
-        With .Worksheets(VAR_SHEET)
-            idx = .Range(IDX_SRC_NAME)
-            Set Location = .Range(TICKER_TABLES).Offset(0, (idx - 1) * 2)
-             .Range(IDX_SEC_SYMBOL) = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            ' Remove header
-            ' Find [DATA]
-            n = 0
-            Do While Location.Offset(n, 0) <> "[DATA]"
-                n = n + 1
-            Loop
-            .Range(Location.Offset(1, 0), Location.Offset(n, 1)).Delete Shift:=xlUp
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.Count
-            End With
-        
-        '        .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 0), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-    End With
-End Sub
-
-Private Function GetListPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/names.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range(SEL_SOURCE)
-        QryPathStr = QryPathStr & "&board=" & .Range(SEL_BOARD)
-        QryPathStr = QryPathStr & "&category=STOCKS"
-        '.Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "RBC online connection kit"
-Public Const PROGRAM_VERSION As String = "version 1.0"
-
-' Estimation dates
-'-----------------------------------
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-' Public Const ESTIMATION_DATE As Long = 19980915
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-' Private Sheet Vars
-'-----------------------------------
-Public Const VAR_SHEET = "Vars"
-
-Public Const LIST_SRC_NAME = "LIST_SRC_NAME"
-Public Const LIST_SRC_TICKER = "LIST_SRC_TICKER"
-Public Const LIST_SRC_BRD = "LIST_SRC_BRD"
-Public Const LIST_PERIODICITY = "LIST_PERIODICITY"
-
-Public Const IDX_SRC_NAME = "IDX_SRC_NAME"
-Public Const IDX_SEC_SYMBOL = "IDX_SEC_SYMBOL"
-Public Const IDX_SEC_NAME = "IDX_SEC_NAME"
-Public Const IDX_PERIODICITY = "IDX_PERIODICITY"
-Public Const IDX_WINDOW = "IDX_WINDOW"
-Public Const IDX_MARGIN = "IDX_MARGIN"
-
-Public Const SEL_SOURCE = "SEL_SOURCE"
-Public Const SEL_BOARD = "SEL_BOARD"
-Public Const SEL_SEC_SYMBOL = "SEL_SEC_SYMBOL"
-Public Const SEL_SEC_NAME = "SEL_SEC_NAME"
-Public Const SEL_PERIODICITY = "SEL_PERIODICITY"
-Public Const SEL_WINDOW = "SEL_WINDOW"
-Public Const SEL_MARGIN = "SEL_MARGIN"
-Public Const SEL_HISTORY = "SEL_HISTORY"
-Public Const SEL_NEXT_INTERVAL = "SEL_NEXT_INTERVAL"
-
-Public Const TICKER_TABLES = "TICKER_TABLES"
-
-' Private Sheet RawData
-'-----------------------------------
-Public Const RAW_DATA_SHEET As String = "RawData"
-Public Const PRICE_TABLE As String = "B1"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const CLOSE_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const HIGH_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const DATE_STAMP_OFFSET = VOLUME_IDX + 1
-Public Const TIME_STAMP_OFFSET = VOLUME_IDX + 4
-Public Const DATE_TIME_STAMP_SIZE = 5
-
-' Prices table constants
-'-----------------------------------
-Public Const MIN_PRICE_VALUE = 1
-<<<<<<
-======================
-mWebQuery
->>>>>>
-Attribute VB_Name = "mWebQuery"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .Name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.Name = QryName Then
-            WebQuery.Delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.Name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim curdate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    curdate = year * 10000
-    curdate = curdate + month * 100
-    curdate = curdate + day
-    If curdate > end_date Then
-        subAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mInterface
->>>>>>
-Attribute VB_Name = "mInterface"
-Option Explicit
-
-Public Function fnSourceGetCount() As Integer
-    fnSourceGetCount = ThisWorkbook.Sheets(VAR_SHEET).Range(LIST_SRC_NAME).Rows.Count
-End Function
-
-Public Function fnSourceGetListItem(ByVal ItemIdx As Integer) As String
-    If ItemIdx >= 1 And ItemIdx <= fnSourceGetCount Then
-        fnSourceGetListItem = ThisWorkbook.Sheets(VAR_SHEET).Range(LIST_SRC_NAME).Cells(ItemIdx, 1)
-    Else
-        fnSourceGetListItem = ""
-    End If
-End Function
-
-Public Function fnSourceGetListItemIndex(ByRef ItemName As String) As Integer
-    Dim i, Res As Integer
-    Res = -1
-    For i = 1 To fnSourceGetCount
-        If ThisWorkbook.Sheets(VAR_SHEET).Range(LIST_SRC_NAME).Cells(i, 1) = ItemName Then
-            Res = i
-            Exit For
-        End If
-    Next i
-    fnSourceGetListItemIndex = Res
-End Function
-
-Public Sub subSourceListItemSelect(ByVal ItemIdx As Integer)
-    If ItemIdx >= 1 And ItemIdx <= fnSourceGetCount Then
-        ThisWorkbook.Sheets(VAR_SHEET).Range(IDX_SRC_NAME) = ItemIdx
-    End If
-End Sub
-
-Public Function fnSourceListItemGetSelected() As Integer
-    fnSourceListItemGetSelected = ThisWorkbook.Sheets(VAR_SHEET).Range(IDX_SRC_NAME)
-End Function
-
-Public Sub subSourceUpdateTickerList()
-    UpdateTickerList ThisWorkbook
-End Sub
-
-Public Function fnTickerGetCount(SrcIdx As Integer) As Integer
-
-End Function
-
-'fnTickerGetListItem(SrcIdx as Integer, idx as Integer) as String
-'fnTickerSetCombo(ComboBox as Shape) as Integer;
-'fnTickerGetListItemIndex(SrcIdx as Integer, ItemName as String) as Integer
-
-'fnNameGetCount(SrcIdx as Integer) as Integer
-'fnNameGetListItem(SrcIdx as Integer, idx as Integer) as String;
-'fnNameSetCombo(ComboBox as Shape) as Integer;
-'fnNameGetListItemIndex(SrcIdx as Integer, ItemName as String) as Integer;
-
-'fnIntervalGetCount(SrcIdx as Integer) as Integer
-'fnIntervalGetListItem(SrcIdx as Integer, idx as Integer) as String;
-'fnIntervalSetCombo(ComboBox as Shape) as Integer;
-'fnIntervalGetListItemIndex(SrcIdx as Integer, ItemName as String) as Integer;
-
-'fnEnableNextInterval(Enable as Boolean) as Boolean;
-
-'fnUpdateHistory(Src as Integer, Ticker as Integer, Periodicity as Integer, Window as Integer, Margin as Integer, OutRange as Range) as Integer;
-'fnUpdateHistoryDialog(OutRange as Range) as Integer;
-
-Sub subAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{17BC5A78-8DD4-11D2-B34E-525400DB02FE}{17BC5A6E-8DD4-11D2-B34E-525400DB02FE}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub DataProvider_Click()
-    ActiveWorkbook.FollowHyperlink Address:="http://www.rbc.ru/", _
-    NewWindow:=True
-End Sub
-<<<<<<
-======================
-aTest
->>>>>>
-Attribute VB_Name = "aTest"
-Option Explicit
-
-Sub Test()
-    subSourceListItemSelect 1
-End Sub
-
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Macro1()
-Attribute Macro1.VB_Description = "Macro recorded 07.12.98 by Nickolai Garbuz"
-Attribute Macro1.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro1 Macro
-' Macro recorded 07.12.98 by Nickolai Garbuz
-'
-
-'
-    ActiveSheet.Shapes("Drop Down 1").Select
-    With Selection
-        .ListFillRange = "LIST_SRC_NAME"
-        .LinkedCell = "IDX_SRC_NAME"
-        .DropDownLines = 8
-        .Display3DShading = False
-    End With
-End Sub
-<<<<<<
-Project Name : '000.xls'
-Quirk - duff tag length======================
-Sum in Words
->>>>>>
-Attribute VB_Name = "Sum in Words"
-
-Dim DAN_NAMES
-Dim DAN_100S
-Dim Dan_20S
-Dim DAN_10S
-Dim DAN_1S
-
-Dim Limit  As Double
-Dim TempStr As String
-Dim A As Double
-Dim B As Double
-Dim OffsetM As Integer
-Dim OffsetOne As Integer
-Dim OffsetDec As Integer
-Dim Kop As Integer
-Dim REnd As Integer
-Dim M As Integer
-
-
-
-Function �������(Val) As String
-Attribute �������.VB_ProcData.VB_Invoke_Func = " \n14"
- 
-    DAN_NAMES = Array("�������� ", "��������A ", "����������", "������� ", "�������� ", "��������� ", "������ ", "������ ", "����� ")
-    DAN_100S = Array("���", "������ ", "������ ", "��������� ", "������� ", "�������� ", "������� ", "��������� ", "��������� ")
-    Dan_20S = Array("��������", "�������� ", "����� ", "��������� ", "���������� ", "��������� ", "����������� ", "��������� ")
-    DAN_10S = Array("������", "�����������", "����������", "����������", "������������", "����������", "�����������", "����������", "������������", "������������")
-    DAN_1S = Array("����", "���", "���", "������", "����", "�����", "����", "������", "������", "����", "��E", "���", "������", "����", "�����", "����", "������", "������")
-    Limit = 10 ^ 12
-    TempStr = ""
-    B = 0
-    OffsetM = 0
-    OffsetOne = 0
-    OffsetDec = 0
-    Kop = 0
-    REnd = 0
-    M = 0
-    
-    ' Val = Left(Val, Len(Val) - 3) & "." & Right(Val, 2)
-    Kop = (Val - Int(Val)) * 100   '�������
-    
-    If Val > Limit Then
-         Beep
-         ������� = "������������ !!!"
-         Exit Function
-   End If
-   
-   Val = Int(Val)
-    If Val = 0 Then
-        TempStr = "����"
-    End If
-    Do Until Int(Limit) <= 0
-        Limit = Limit / 1000
-        B = Int(Val / Limit)
-   
-        If Limit = 1000 Then OffsetOne = 9
-        If B > 0 Then MakeStr
-        Val = Val - B * Limit
-        OffsetOne = 0
-        OffsetM = OffsetM + 3
-    Loop
-Kopeyki:
-     
-    If Kop > 9 Then
-        ������� = TempStr & "  ������ " '& Str$(Kop) & "���."
-    Else
-          ������� = TempStr & "  p�����" ' 00 ���."
-    End If
-   
- End Function
-
-Sub MakeStr()
-Attribute MakeStr.VB_ProcData.VB_Invoke_Func = " \n14"
-
-    If B = 0 Then GoTo Ex
-    REnd = B
-    OffsetDec = Int(REnd / 100)
-    If OffsetDec > 0 Then Make100
-    REnd = REnd - OffsetDec * 100
-    If REnd >= 20 Then
-        OffsetDec = Int(REnd / 10)
-        If OffsetDec > 0 Then Make20
-        REnd = REnd - OffsetDec * 10
-        If REnd > 0 Then Make1
-    Else
-        If REnd > 9 Then
-            Make10
-        Else
-            If REnd > 0 Then Make1
-        End If
-    End If
-    If REnd >= 5 Or REnd = 0 Then
-       M = 2
-    Else
-        If REnd >= 2 Then M = 1 Else M = 0
-   End If
-    If Limit <> 1 Then MakeName
-Ex:
-    End Sub
-    
-Sub Make100()
-Attribute Make100.VB_ProcData.VB_Invoke_Func = " \n14"
-    TempStr = Trim$(TempStr) + " " + DAN_100S(OffsetDec - 1)
-End Sub
-           
-Sub Make20()
-Attribute Make20.VB_ProcData.VB_Invoke_Func = " \n14"
-    TempStr = Trim$(TempStr) + " " + Trim$(Dan_20S(OffsetDec - 2))
-End Sub
-
-Sub Make10()
-Attribute Make10.VB_ProcData.VB_Invoke_Func = " \n14"
-    TempStr = Trim$(TempStr) + " " + DAN_10S(REnd - 10)
-End Sub
-      
-Sub Make1()
-Attribute Make1.VB_ProcData.VB_Invoke_Func = " \n14"
-     TempStr = Trim$(TempStr) + " " + Trim$(DAN_1S(REnd + OffsetOne - 1))
-End Sub
-     
-Sub MakeName()
-Attribute MakeName.VB_ProcData.VB_Invoke_Func = " \n14"
-    TempStr = Trim$(TempStr) + " " + Trim$(DAN_NAMES(OffsetM + M)) '10
-'    TempStr = Trim$(TempStr) + " " + Trim$(DAN_NAMES(2))
-End Sub
- 
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mRead
->>>>>>
-Attribute VB_Name = "mRead"
-Option Explicit
-' M����� ��� ������ ������ � �����
-
-
-
-Sub ReadData1(aPoint As String, dt As Integer, _
-              p As PriceData)
-'������������� ���� PriceData �� ������� ���� - 1
-'k��������� �� ����� ��� hist ��������� �����
-'aPoint - ������ �������
-'Hist - �������� ������� - ��������������,
-'       ����  ���������� ������� ������ �����������
-' dt -  ��� �� ������� - ���������� ������� ��������
-' ���������: ������� ��� - p As PriceData
-'����. ������ ��� ������ ������� �������������� ������ (������)
- Dim n As Integer, i As Integer
-'����������� ����� ����� ������� - n
- Dim theRange As Range
- Set theRange = ActiveSheet.Range(aPoint)
- n = 0
- Do While IsEmpty(theRange.Offset(n, 0).Value) = False
-     n = n + 1
- Loop
- If n = 0 Then             '���������� ������
-    p.nWin = 0
-    GoTo done
- End If
-' ����� ����� ���������� ()
- If p.nWin > (n - 3) \ dt + 1 Then ' ��������� �������
-    p.nWin = (n - 3) \ dt + 1 '
- End If
- Dim t As Integer, s As Integer
- For t = 0 To p.nWin - 1
-      s = n - t * dt - 1
-      p.D(p.nWin - t) = theRange.Offset(s, 0).Value
-      p.O(p.nWin - t) = theRange.Offset(s, 1).Value
-      p.H(p.nWin - t) = theRange.Offset(s, 2).Value
-      p.L(p.nWin - t) = theRange.Offset(s, 3).Value
-      p.C(p.nWin - t) = theRange.Offset(s, 4).Value
-      p.V(p.nWin - t) = theRange.Offset(s, 5).Value
- Next t
-done:
-End Sub
-
-
-Function StrNum(aPoint As String)
-' ���������� ����� ����� �������
- Dim theRange As Range
- Set theRange = ActiveSheet.Range(aPoint)
- StrNum = 0
- Do While IsEmpty(theRange.Offset(StrNum, 0).Value) = False
-     StrNum = StrNum + 1
- Loop
-End Function
-
-
-<<<<<<
-======================
-mModel1
->>>>>>
-Attribute VB_Name = "mModel1"
-Option Explicit
-
-'Type Model_1                 ' ��������� ������ -1
-'     tE As Integer           ' ������ ���� ������
-'     nAuto  As Integer       ' ������� �������������
-'     nDiff As Integer        ' ������� ������� ��������
-'     nFac  As Integer        ' ����� ��������
-'     a() As Double           '���� �������������
-'     b() As Double           '���� ��������
-'     Var As Double           '�������� ������
-'
-'     alfa  As Double         ' ������� ����������� ��������
-'     x() As Double           ' �������� ���
-'     y() As Double           ' ��� ���������
-'     u As Variant            ' �������
-
-Sub InitModel1(Point As String, tEnd As Integer, p As Model_1)
-' ������������� �������� ���������� � ��������� ������
-' tE - ���������
-Dim theRange As Range
-Set theRange = ActiveSheet.Range(Point) '����� ����� ���. ������
-p.tE = tEnd
-p.alfa = 2 / (theRange.Offset(0, 0).Value + 1)
-p.nAuto = theRange.Offset(1, 0).Value
-p.nDiff = theRange.Offset(2, 0).Value
-p.nFac = theRange.Offset(3, 0).Value
-p.Omega = theRange.Offset(4, 0).Value
-p.Acc = theRange.Offset(5, 0).Value
-
-ReDim p.a(1 To AUTO_MAX) As Double
-ReDim p.b(1 To FAC_MAX) As Double
-ReDim p.x(1 To tEnd) As Double, p.y(1 To tEnd) As Double
-ReDim p.u(1 To FAC_MAX, 1 To tEnd) As Double
-End Sub
-Sub InitMemory(p As Model_1)
-' ��������� ������ ��� Model_1
-' tE - ���������
-ReDim p.a(1 To AUTO_MAX) As Double
-ReDim p.b(1 To FAC_MAX) As Double
-ReDim p.x(1 To tEnd) As Double, p.y(1 To tEnd) As Double
-ReDim p.u(1 To FAC_MAX, 1 To tEnd) As Double
-End Sub
-
-Sub EraseModel_1(p As Model_1)
-'
- Erase p.a
- Erase p.b
- Erase p.x
- Erase p.y
- Erase p.u
-End Sub
-
-Function tNoise1(p As Model_1)
-'����������� ����� ������� dom{Noise} � ������ ������ �������
-' tu --> tNoise
-p.tNoise = p.p + p.nDiff + 1
-If p.tNoise < p.tu Then
-   p.tNoise = p.tu
-End If
-End Function
-
-' Estimation *************************************
-
-Function SSum(p As Model_1)  ' o'key
-'����� ��������� �������� Model_1-��������
-' < a,b;nDiff,nAuto,nFac,y,tNoise > ---> SSum(a,b)
-
-Dim noise As Double, val As Double
-Dim t As Integer, i As Integer
-SSum = 0
-For t = p.tNoise To p.tE
-' Noise = Noise(t) definition ----------------
-  noise = p.y(t)
-  For i = 1 To p.nAuto
-     noise = noise + p.a(i) * p.y(t - i)
-  Next i
-  For i = 1 To p.nFac
-     noise = noise - p.b(i) * p.u(i, t - 1)
-  Next i
-' Noise(t) is defined------------------------
-  val = noise * noise
-  If p.Omega < 1 Then
-     val = p.Omega ^ (p.tE - t) * val
-  End If
-  SSum = SSum + val
-Next t
-End Function
-
-Sub GradSSum(x() As Double, p As Model_1, grad() As Double)
-'�������� ���������� ����� ��������� �������� Model_1
-' � ����� x = {a,b}
-Dim t As Integer, i As Integer
-Dim noise As Double, V As Double
-For i = 1 To p.nAuto + p.nFac    'dim of the problem = p.nAuto + p.nFac
-  grad(i) = CDbl(0)
-Next i
-For t = p.tNoise To p.tE
-   
-'  Noise = Noise(t) definition ----------------
-   noise = p.y(t)
-   For i = 1 To p.nAuto
-     noise = noise + x(i) * p.y(t - i)
-   Next
-   For i = 1 To p.nFac
-     noise = noise - x(p.nAuto + i) * p.u(i, t - 1)
-   Next i
-'  Noise(t) is defined------------------------
-   If p.Omega < 1 Then
-      noise = noise * p.Omega ^ (p.tE - t)
-   End If
-   For i = 1 To p.nAuto
-      grad(i) = grad(i) + p.y(t - i) * noise
-   Next i
-   For i = 1 To p.nFac
-      grad(p.nAuto + i) = grad(p.nAuto + i) - p.u(i, t - 1) * noise
-   Next i
-Next t
-
-For i = 1 To p.nAuto + p.nFac
-       grad(i) = 2 * grad(i)
-Next i
-
-End Sub
-
-Sub DetNoise(p As Model_1, noise() As Double)  ' ??? ������, ���������
-' <p,d, a,b,y, tNoise > --> Noise
-'����������� ���� � Model_1 - ������ � ����������� ������
-'����������� ���� �� ���y ��������� y, dom(y) = [d+1,tx]
-'dom(noise) = [tNoise , tE]
-Dim t As Integer, i As Integer
-For t = p.tNoise To p.tE
-  noise(t) = p.y(t)
-  For i = 1 To p.nAuto
-     noise(t) = noise(t) + p.a(i) * p.y(t - i)
-  Next
-  For i = 1 To p.nFac
-     noise(t) = noise(t) - p.b(i) * p.u(i, t - 1)
-  Next i
-Next t
-End Sub
-Sub VarNoise(p As Model_1)
-' <p,d, a,b,y, tNoise > --> Noise
-'����������� �������� ����������� ���� = �������� ������ ��������
-'dom(noise) = [tNoise, tE]
-Dim t As Integer, i As Integer, noise As Double
-p.var = 0
-For t = p.tNoise To p.tE
-  noise = p.y(t)
-  For i = 1 To p.nAuto
-     noise = noise + p.a(i) * p.y(t - i)
-  Next
-  For i = 1 To p.nFac
-    noise = noise - p.b(i) * p.u(i, t - 1)
-  Next i
-  p.var = p.var + noise * noise
-Next t
-p.var = p.var / (p.tE - p.tNoise + 1)
-End Sub
-
-
-'************************************************************************
-Sub EffFactor1(p As Model_1, Factor() As Double, tFactor As Integer, _
-               Status As Integer, Corr As Double) '�������� ���������
-' ������ ������������� ������������� ������
-' Factor  ������
-' �������� ������: c�. InitModel1
-' tE          ������ ���� ������
-' nAuto       ������� �������������
-' nDiff       ������� ������� ��������
-' nFac = 1    ����� ��������
-' Omega       �������� �����������
-' x,y = Diff(x, nDiff) ��� ��������� - ����������
-' u(1,1:tE) ������
-' Factor -  ������
-' tFactor - ����� ������� ������� ����������� �������
-' ���������:
-' Status - ������ ����������, ������� ���������� c ���������� x,
-' ����������� ������ �������� - Var( ��. ������ ����������� ���� )
-  p.tu = tFactor
-' ���������� ----------------------------------------------------
-  Dim tCorr As Integer
-  tCorr = p.nDiff + 1  '
-  If tCorr < p.tu Then
-     tCorr = p.tu
-  End If
-  Corr = CorrXY(p.y, Factor, tCorr, p.tE, s:=1, ind:=1)
-' ������� Factor �� y c ��������� 1
-' ��� ���������� ------------------------------------------------
-
-'������ ������ � ���� �������� ----------------------------------
- p.tNoise = p.nAuto + p.nDiff + 1
- If p.tNoise < p.tu Then
-   p.tNoise = p.tu
- End If   '  tNoise is defined
- Dim t As Integer
- For t = 1 To p.tE    'u(1,.) <-- Indicator
-    p.u(1, t) = Factor(t)
- Next t
- 
-'eps = Acc * 0.00001
-'ConjGrad1 MODEL1, 0.000000001, Status
- nConjGrad1 p, p.Acc * 0.001, Status          ', Acc
- VarNoise p  ' �������� ����������� ����
-'��� - ������ ������ � ���� �������� --------------------------
-End Sub
-
-
-Sub nConjGrad1(ptr As Model_1, eps As Double, _
-               Status As Integer)   ' , Accuracy As Double)
-'   ������ ���������� AR-������ �� ���������� y(t)
-'   �������� ������:
-'   y(1:ty), dom(y)= [ts,ty]
-'   pa - ������� �������������
-'   eps - �������� ����������� ���������� a(1:p)
-'   ���������:
-'   a(1:pa) - ��������� �������������
-'   var - �������� ������ ����
-'   Status = 1 - �������� ����������
-    Dim r As Double, r1 As Double, alfa As Double, beta As Double
-    Dim nDim As Integer, m As Integer, i As Integer, k As Integer
-    nDim = ptr.nAuto + ptr.nFac
-    ReDim x(1 To nDim) As Double
-    ReDim grad(1 To nDim) As Double
-    ReDim grad0(1 To nDim) As Double
-    ReDim p(1 To nDim) As Double
-    
-'--------------------------------------------
-'--------------------------------------------
-'   x optimization point
-
-    For i = 1 To nDim     ' init data x <-- 0 x = {a,b}
-        x(i) = CDbl(0)
-    Next i
-'   DetGrad x, grad0, n 'grad <-- grad(0)
-    GradSSum x, ptr, grad0
-    Status = 0
-'------------------------------------------
-For m = 1 To 10 * nDim     '
-    For i = 0 To nDim - 1 ' ------------------------------
-'       1. grad and r - determination at x = x(i)
-'       DetGrad x, grad, n 'grad <-- grad(x)
-        GradSSum x, ptr, grad
-        r = 0        'r <-- |grad(x)|
-        For k = 1 To nDim
-            r = r + grad(k) * grad(k)
-        Next k
-
-'       2. .....
-'       Accuracy = Sqr(r)   ' �������� �� ���������
-        If Sqr(r) <= eps Then
-           For k = 1 To ptr.nAuto
-               ptr.a(k) = x(k)
-           Next k
-           For k = 1 To ptr.nFac
-               ptr.b(k) = x(ptr.nAuto + k)
-           Next k
-           ptr.oVar = SSum(ptr)
-           Status = 1
-           GoTo done
-        End If
-'3      beta determination
-        If i > 0 Then
-           beta = r / r1
-        End If
-'4      p - �odification
-        For k = 1 To nDim
-            If i = 0 Then
-               p(k) = grad(k)
-            Else
-               p(k) = grad(k) + beta * p(k)
-            End If
-        Next k
-'5      alfa = -(p,grad(x))/(p,Cp) determination;  s = (p,Cp)
-        alfa = CDbl(0)
-        For k = 1 To nDim ' alfa = (p,grad(x))
-            alfa = alfa + p(k) * grad(k)
-        Next k
-        
-'       DetGrad p, grad, n
-        GradSSum p, ptr, grad
-        r1 = CDbl(0)
-        For k = 1 To nDim ' beta = (p,grad(p)-grad(0))
-            r1 = r1 + p(k) * (grad(k) - grad0(k)) ' !!! i = 0
-        Next k
-        alfa = -alfa / r1 '!? +
-'6      x() modification
-        r1 = CDbl(0)
-        For k = 1 To nDim  ' beta = (p,grad(x))
-            r1 = r1 + Abs(alfa * p(k))
-        Next k
-        For k = 1 To nDim   ' beta = (p,grad(x))
-           x(k) = x(k) + alfa * p(k)
-        Next k
-'*      ����������� r1
-        r1 = r  '!
-    Next i
-Next m
-    
-Erase grad
-Erase grad0
-Erase p
-Erase x
-
-'For k = 1 To ptr.nAuto
-'   ptr.a(k) = x(k)
-'Next k
-'For k = 1 To ptr.nFac
-'    ptr.b(k) = x(ptr.nAuto + k)
-'Next k
-'ptr.oVar = SSum(ptr)
-
-done:
-End Sub
-
-Function xForecast(t As Integer, p As Model_1) As Double
-' ������� x(t+1) � ������ t, tf <= t <= tE, tf = max{nAuto,tu}
-ReDim ad(1 To p.nAuto + p.nDiff + 1) As Double
-DetAD p, ad
-Dim i As Integer
-xForecast = 0
-For i = 1 To p.nAuto + p.nDiff
-    xForecast = xForecast - ad(i) * p.x(t + 1 - i)
-Next i
-For i = 1 To p.nFac
-    xForecast = xForecast + p.b(i) * p.u(i, t)
-Next i
-End Function
-
-Sub DetAD(ptr As Model_1, ad() As Double) ' ???
-' ����������� Ad(D) = A(D)*(1-D)^d = 1 + ad(1)D + .... +ad(p+d)D^(p+d)
-' Dx(t)= x(t-1)
-' dim(a) = p+d
-  Dim i As Integer, r As Integer
-  If ptr.nAuto = 0 And ptr.nDiff = 0 Then
-     GoTo done
-  End If
-' case r = 0
-  For i = 1 To ptr.nAuto
-      ad(i) = ptr.a(i)
-  Next i
-  
-  If ptr.nDiff = 0 Then
-     GoTo done
-  End If
-  For r = 1 To ptr.nDiff
-      
-      If ptr.nAuto + r >= 2 Then
-         ad(ptr.nAuto + r) = -ad(ptr.nAuto + r - 1)
-      Else
-         ad(ptr.nAuto + r) = 0
-      End If
-      For i = ptr.nAuto + r - 1 To 2 Step -1
-          ad(i) = ad(i) - ad(i - 1)
-      Next i
-       ad(1) = ad(1) - CDbl(1)
-  Next r
-done:
-End Sub
-
-<<<<<<
-======================
-mFactors
->>>>>>
-Attribute VB_Name = "mFactors"
-Option Explicit
-' �������
-' ������ - 1 ***************************************************
-' ���������� - ���� �� ��������� ����� �������, �� ��� ����� 1
-'  No - 2
-Sub Histogramm(p As PriceData, _
-               m0 As Integer, _
-               m1 As Integer, _
-               m2 As Integer, _
-               Hist() As Double)
-' ����������� = MACD - SIGNAL , m0=24 > m1=12 > m2=9
-' dom{Histogramm} = dom{p}
-ReDim MACD(1 To p.nWin) As Double
-ReDim Signal(1 To p.nWin) As Double
-
-Dim t As Integer
-' MACD = MA(CLOSE,m1) - MA(CLOSE,m0)
-ExpMA1 p.C, 1, p.nWin, 2 / (m1 + 1), MACD
-ExpMA1 p.C, 1, p.nWin, 2 / (m0 + 1), Signal
-For t = 1 To p.nWin
-    MACD(t) = MACD(t) - Signal(t)
-Next t
-ExpMA1 MACD, 1, p.nWin, 2 / (m2 + 1), Signal
-For t = 1 To p.nWin
-    Hist(t) = MACD(t) - Signal(t)
-Next t
-
-Erase MACD
-Erase Signal
-End Sub
-'****************************************************************
-Sub WilliamsInd1(p As PriceData, alfa As Double, Wlm() As Double)
-' Williams indicator - 1
-' dom(Wlm) = [1,tE]
-Dim t As Integer
-For t = 1 To p.nWin
-    Wlm(t) = (p.H(t) - p.C(t)) / (p.H(t) - p.L(t))
-Next t
-If alfa <> 1 Then
-  [mTimeSer].ExpMA1 Wlm, 1, p.nWin, alfa, Wlm
-End If
-End Sub
-
-' No-2
-Sub WilliamsInd(p As PriceData, m As Integer, Wlm() As Double)
-' Williams indicator - 1
-' dom(Wlm) = [m+2,tE]
-' m - ?
-Dim t As Integer, s As Integer
-Dim mxH As Double, mnL As Double
-For t = m + 2 To p.nWin
-  mxH = p.H(t - m + 1):  mnL = p.L(t - m + 1)
-  For s = t - m + 2 To t
-      If mxH < p.H(s) Then
-         mxH = p.H(s)
-      End If
-      If mnL > p.L(s) Then
-         mnL = p.L(s)
-      End If
-  Next s
-  Wlm(t) = (mxH - p.C(t)) / (mxH - mnL)
-'   Wlm(t) = (p.C(t) - p.L(t)) / (p.H(t) - p.L(t))
-Next t
-End Sub
-'Sub WlmSignal(p As PriceData, _
-'              m As Integer, _
-'              LMax As Double, _
-'              LMin As Double, _
-'              Signal() As Double _
-'              )  ' ???
-' Williams Signal - 1
-' dom(Signal) = dom(Wlm)
-'ReDim Wlm(1 To p.nWin) As Double
-'WilliamsInd p, m, Wlm
-'Dim t As Integer
-'For t = m + 2 To p.nWin
-'  Signal(t) = 0
-'  If Wlm(t - 1) < Wlm(t) And Wlm(t - 1) <= LMin Then
-'         Signal(t) = 1
-'  End If
-'  If Wlm(t - 1) > Wlm(t) And Wlm(t - 1) >= LMax Then
-'         Signal(t) = -1
-'  End If
-'
-'Next t
-'End Sub
-
-
-
-
-' No-3
-Sub dADind(p As PriceData, alfa As Double, dAD() As Double)
-' Accumulator/Distribution
-' dom(dAD)= [1,tE]
-Dim t As Integer
-For t = 1 To p.nWin
-    dAD(t) = ((p.C(t) - p.O(t)) / (p.H(t) - p.L(t))) * p.V(t)
-Next t
-If alfa <> 1 Then
-  [mTimeSer].ExpMA1 dAD, 1, p.nWin, alfa, dAD
-End If
-End Sub
-
-' No-4
-Sub dOBVind(p As PriceData, dOBV() As Double)
-' On Balance Volume
-' dom(dOBV)= [2,tE]
-Dim t As Integer
-For t = 2 To p.nWin
-    dOBV(t) = 1
-    If p.C(t) = p.C(t - 1) Then
-       dOBV(t) = 0
-    End If
-    If p.C(t) < p.C(t - 1) Then
-       dOBV(t) = -1
-    End If
-Next t
-End Sub
-' ���������� ������
-Sub IndBear(ptr As PriceData, m As Integer, iBear() As Double)
-' ��������� ���� ��������
-' Dom(iBear) = [1, tE]
-Dim t As Integer
-ReDim MA(1 To ptr.nWin) As Double
-ExpMA1 ptr.C, 1, ptr.nWin, 2 / (m + 1), MA
-For t = 1 To ptr.nWin
-    iBear(t) = ptr.L(t) - MA(t)
-Next t
-Erase MA
-End Sub
-Sub IndBull(ptr As PriceData, m As Integer, iBull() As Double)
-' ��������� ���� �����
-' Dom(iBull) = [1, tE]
-Dim t As Integer
-ReDim MA(1 To ptr.nWin) As Double
-ExpMA1 ptr.C, 1, ptr.nWin, 2 / (m + 1), MA
-For t = 1 To ptr.nWin
-    iBull(t) = ptr.H(t) - MA(t)
-Next t
-Erase MA
-End Sub
-Sub Force(ptr As PriceData, m As Integer, Force() As Double)
-' ��������� ���� = D(iBull+iBear)
-' Dom(Force) = [2, tE]
-Dim t As Integer
-ReDim MA(1 To ptr.nWin) As Double
-ExpMA1 ptr.C, 1, ptr.nWin, 2 / (m + 1), MA
-For t = 2 To ptr.nWin
-    Force(t) = ptr.H(t) + ptr.L(t) - MA(t) - (ptr.H(t - 1) + ptr.L(t - 1) - MA(t - 1))
-Next t
-Erase MA
-End Sub
-Sub ForceIndex(ptr As PriceData, m As Integer, iForce() As Double)
-' ��������� ���� = iBull+iBear
-' Dom(ForceIndex) = [2, tE]
-Dim t As Integer
-ReDim Ser(1 To ptr.nWin) As Double
-For t = 2 To ptr.nWin
-    Ser(t) = ptr.V(t) * (ptr.C(t) - ptr.C(t - 1))
-Next t
-ExpMA1 Ser, 1, ptr.nWin, 2 / (m + 1), iForce
-Erase Ser
-End Sub
-
-Sub GetIndicator(Num As Integer, ptr As PriceData, ptr1 As Model_1, _
-         NameInd As String, Indicator() As Double, tInd As Integer)
-' ����� ���������� --->  ���������, ����� ������� ������� �����������
-If Num = 1 Then            '   Number 1
-   NameInd = "Histogramm"
-   Histogramm ptr, 24, 12, 9, Indicator
-   tInd = 1
-ElseIf Num = 2 Then        '  Number 2
-   NameInd = "WiLLiams"
-   WilliamsInd ptr, 7, Indicator
-   tInd = 9 ' = m+2, m = 7
-ElseIf Num = 3 Then        '  Number 3
-   NameInd = "A/D changes"  '?
-   dADind ptr, ptr1.alfa, Indicator
-   tInd = 1
-ElseIf Num = 4 Then        '  Number 4
-   NameInd = "OBV changes"
-   dOBVind ptr, Indicator
-   tInd = 2
-ElseIf Num = 5 Then        '  Number 5
-   NameInd = " Force "
-   ForceIndex ptr, m:=7, iForce:=Indicator
-   tInd = 2
-ElseIf Num = 6 Then        '  Number 5
-   NameInd = " Force Index"
-   ForceIndex ptr, m:=7, iForce:=Indicator
-   tInd = 2
-End If
-
-End Sub
-
-
-
-<<<<<<
-======================
-mTimeSer
->>>>>>
-Attribute VB_Name = "mTimeSer"
-
-Option Explicit
-' ��������� ��������� ��������� �����
-
-Sub MoveLeft(x() As Double, t2 As Integer, t1 As Integer)
-' dom x = [t1,t2] ---> dom(x) = [1,t2-t1+1]����� ����� �� ms
-Dim t As Integer
-For t = 1 To t2 - t1 + 1
-    x(t) = x(t + t1 - 1)
-Next t
-End Sub
-
-Sub MoveRight(x() As Double, t2 As Integer, t1 As Integer)
-' dom x = [1,t2-t1+1] ---> dom(x) = [t1,t2] ����� ������ ms
-Dim t As Integer
-For t = t2 - t1 + 1 To 1 Step -1
-    x(t + t1 - 1) = x(t)
-Next t
-
-End Sub
-
-'1. �������������� ��������� �����
-'series differentiation
-Sub Diff1(x() As Double, tx As Integer, D As Integer, y() As Double)
-' x(1:tx), tx, d  ---> y(1:tx)= {Diff^d)x}
-'0 <= d <= tx-1
-'Dom(x)= [1,tx], Dom(y) = [d+1,tx]
-'difference of order D
- Dim t As Integer
- If D = 0 Then   ' Case d = 0
-    For t = tx To 1 Step -1
-        y(t) = x(t)
-    Next t
-    GoTo done
- End If
- 
- For t = tx To 2 Step -1
-     y(t) = x(t) - x(t - 1)
- Next t
- If D = 1 Then
-    GoTo done
- End If
- 'difference of order d
- Dim k As Integer
- For k = 2 To D
-     'define the deifference of order k
-     For t = tx To k + 1 Step -1
-         y(t) = y(t) - y(t - 1)
-     Next t
- Next k
-done:
-End Sub
-
-Sub Diff(x() As Double, tx As Integer, y() As Double)
-'x(1:tx), tx --->y(1:tx)= x(t)-x(t-1)
-'Dom(x)= [1,tx],Dom(y)= [d+1,tx], Dom - is the domain of definion of series
-'difference of order 1
- Dim t As Integer
- For t = tx To 2 Step -1
-     y(t) = x(t) - x(t - 1)
- Next t
-End Sub
-
-Sub RelDiff(x() As Double, tx As Integer, y() As Double)
-'x(1:tx), tx --->y(1:tx)= [x(t)-x(t-1)]/x(t-1)
-'Dom(x)= [1,tx],Dom(y)= [2,tx], Dom - is the domain of definion of series
-'relative difference of order 1
- Dim t As Integer
- For t = tx To 2 Step -1
-     y(t) = (x(t) - x(t - 1)) / x(t - 1)
- Next t
-End Sub
-
-Sub Logarithm(x() As Double, tx As Integer, y() As Double)
-'x(1:tx), tx --->y(1:tx)= Logarithmx(t)
-'Dom(x)= [1,tx],Dom(y)= [1,tx], Dom - is the domain of definion of series
-'difference of log(x(t)
- Dim t As Integer
- For t = 1 To tx
-     y(t) = Log(x(t))
- Next t
-End Sub
-
-Sub DiffLog(x() As Double, tx As Integer, y() As Double)
-'x(1:tx), tx --->y(1:tx)= Log(x(t)/x(t-1))
-'Dom(x)= [1,tx],Dom(y)= [2,tx], Dom - is the domain of definion of series
-'difference of log(x(t)
- Dim t As Integer
- For t = tx To 2 Step -1
-     y(t) = Log(x(t) / x(t - 1))
- Next t
-End Sub
-
-Sub Copy(x() As Double, tx As Integer, y() As Double)
-'x(1:tx), tx --->y(1:tx)= x(t)-x(t-1)
-'Dom(x)= [1,tx],Dom(y)= [2,tx], Dom - is the domain of definion of series
-'difference of log(x(t)
- Dim t As Integer
- For t = 1 To tx
-     y(t) = x(t)
- Next t
-End Sub
-
-
-'**************************************************************************
-'���������� ��������������
- 
- Function Meanf(x() As Double, t1 As Integer, t2 As Integer) As Double
-'x(1:t2), Dom(x) = [t1, t2], t1 <= t2
-'���������� ������� ���� x(t1), ..., x(t2)
-'mean = (x(t1), ..., x(t2))/t
-   Meanf = 0
-   Dim t As Integer
-   For t = t1 To t2
-     Meanf = Meanf + x(t)
-   Next t
-   Meanf = Meanf / CDbl(t2 - t1 + 1)
- End Function
-
-Function Varf(x() As Double, t1 As Integer, t2 As Integer) As Double
-'x(1:t2), Dom(x) = [t1,t2]
-'���������� ��������� ���� x(t), t = t1,t1+1,...,t2
-'[(x(t1)-mx)**2 + ... (x(tx)-mx)**2]/(t2-t1+1), t = t1,...,t2.
-  Dim mx As Double
-  Dim t As Integer
-  mx = 0
-  For t = t1 To t2
-     mx = mx + x(t)
-  Next t
-  mx = mx / CDbl(t2 - t1 + 1)
-  Varf = 0
-  For t = t1 To t2
-    Varf = Varf + (x(t) - mx) * (x(t) - mx)
-  Next t
-  Varf = Varf / CDbl(t2 - t1 + 1)
-End Function
-
-
-Sub AutCov(x() As Double, t0 As Integer, t1 As Integer, m As Integer, _
-           ind As Integer, C() As Double)
-' ���������� ������������������ �������
-' Dom(x) = [t0,t1], m <= (t1-t0+1)/5 !!!
-' c(0:m) , k=0,1,..., m, ind = 0
-' r(0:m)                 ind = 1
-  Dim t As Integer, k As Integer
-  Dim delta As Double, mx As Double
-  
-  mx = 0  ' ����������� ��������
-  delta = CDbl(t1 - t0 + 1)
-  For t = t0 To t1
-     mx = mx + x(t)
-  Next t
-  mx = mx / delta
-  
-  For k = 0 To m
-     C(k) = 0
-     For t = t0 To t1 - k
-          C(k) = C(k) + (x(t + k) - mx) * (x(t) - mx)
-     Next t
-     C(k) = C(k) / delta
-  Next k
-  If ind = 1 Then
-     For k = 1 To m
-        C(k) = C(k) / C(0)
-     Next k
-     C(0) = 1
-  End If
-End Sub
-
-
-
-Function CorrXY(x() As Double, y() As Double, t0 As Integer, t1 As Integer, _
-              s As Integer, ind As Integer) As Double
-' ���������� k���������( ind = 0) ��� ����������( ind = 1) c ��������� s >= 0
-' s > = 0, Cov{ x(t), y(t-s)} if ind = 0, Corr{x(t),y(t-s)} if ind = 1 ?
-  If s >= t1 - t0 Then
-     CorrXY = 0
-  Else  ' s <  t1 - t0
-     CorrXY = 0
-     Dim mx As Double, my As Double
-     mx = Meanf(x, t0, t1)
-     my = Meanf(y, t0, t1)
-     Dim t As Integer
-     For t = s + t0 To t1
-        CorrXY = CorrXY + (x(t) - mx) * (y(t - s) - my)
-     Next t
-     CorrXY = CorrXY / CDbl(t1 - t0 - s + 1)
-     If (ind = 1) Then
-        CorrXY = CorrXY / Sqr(Varf(x, t0, t1) * Varf(y, t0, t1))
-     End If
-  End If
-End Function
-' part II
-' ���������������� ���������� �������
-Sub ExpMA1(x() As Double, t1 As Integer, t2 As Integer, alfa As Double, _
-           s() As Double)
-' x , dom(x) = [t1,t2], - �������� ���
-' 0 <= alfa <= 1 - ������� �����������
-' ���������: S , dom(S) = [t1,t2], - ���������� �������
-' ����� �� ������������ ��� ����������� x  - �����!
-Dim S0 As Double, beta As Double
-Dim k As Integer, t As Integer
-' S0 determination
-If alfa <= 0 Then
-   For t = t1 To t2
-      s(t) = 0
-   Next t
-   GoTo done
-End If
-If alfa >= 1 Then
-   For t = t1 To t2
-      s(t) = x(t)
-   Next t
-   GoTo done
-End If
-S0 = 0
-k = 5    ' ������� ����������, k < (t2-t1+1)/2  !!!
-For t = t1 To t1 + k - 1
-    S0 = S0 + x(t)
-Next t
-S0 = S0 / k
-'main cycle
-beta = 1 - alfa
-s(t1) = alfa * x(t1) + beta * S0
-For t = t1 + 1 To t2
-    s(t) = alfa * x(t) + beta * s(t - 1)
-Next t
-done:
-End Sub
-
-Sub ExpMA2(x() As Double, t1 As Integer, t2 As Integer, alfa As Double, _
-           s() As Double, err() As Double)
-' x , dom(x) = [t1,t2], - �������� ���
-' 0 <= alfa <= 1 - ������� �����������
-' ���������: S , dom(S) = [t1,t2], - ���������� �������
-'                err(t) = x(t) - S(t)
-Dim S0 As Double, beta As Double
-Dim k As Integer, t As Integer
-' S0 determination
-If alfa <= 0 Then
-   For t = t1 To t2
-      s(t) = 0: err(t) = x(t)
-   Next t
-   GoTo done
-End If
-If alfa >= 1 Then
-   For t = t1 To t2
-      s(t) = x(t): err(t) = 0
-   Next t
-   GoTo done
-End If
-S0 = 0
-k = 5    ' ������� ����������, k < (t2-t1+1)/2  !!!
-For t = t1 To t1 + k - 1
-    S0 = S0 + x(t)
-Next t
-S0 = S0 / k
-'main cycle
-beta = 1 - alfa
-s(t1) = alfa * x(t1) + beta * S0
-err(t1) = x(t1) - s(t1)
-For t = t1 + 1 To t2
-    s(t) = alfa * x(t) + beta * s(t - 1)
-    err(t) = x(t) - s(t)
-Next t
-done:
-End Sub
-
-Sub ExpMA3(x() As Double, t1 As Integer, t2 As Integer, alfa As Double, _
-           s() As Double, err() As Double)
-' x , dom(x) = [t1,t2], - �������� ���
-' 0 < alfa < 1 - ������� �����������
-' ���������: S , dom(S) = [t1,t2], - ���������� �������
-'                err(t) = x(t) - S(t-1)
-Dim S0 As Double, beta As Double
-Dim k As Integer, t As Integer
-' S0 determination
-S0 = 0
-k = 5    ' ������� ����������, k < (t2-t1+1)/2  !!!
-For t = t1 To t1 + k - 1
-    S0 = S0 + x(t)
-Next t
-S0 = S0 / k
-'main cycle
-beta = 1 - alfa
-s(t1) = alfa * x(t1) + beta * S0
-err(t1) = x(t1) - s(t1)
-For t = t1 + 1 To t2
-    s(t) = alfa * x(t) + beta * s(t - 1)
-    err(t) = x(t) - s(t - 1)
-Next t
-End Sub
-
-Sub Decimation(x() As Double, tx As Integer, dt As Integer, y() As Double, ty As Integer)
-' ��������� �� �����: {x(), tx, dt }  --> { y(), ty} (y = x �������� !)
-' dom(x) = [1, tx],
-Dim k As Integer
-ty = ((tx - 1) \ dt) + 1
-For k = 1 To ty
-    y(k) = x(tx - (ty - k) * dt)
-Next k
-End Sub
-
-
-Function SignNum(x() As Double, _
-           y() As Double, _
-           s As Integer, _
-           tB As Integer, _
-           tE As Integer _
-           ) As Integer
-' ������������� ����� ���������� ������ ������������������� x � y
-Dim t As Integer  ' ???
-SignNum = 0
-For t = tB + s To tE
-    If x(t) * y(t - s) > 0 Then
-       SignNum = SignNum + 1
-    End If
-Next t
-SignNum = SignNum / (tE - tB + 1)
-End Function
-
-<<<<<<
-Project Name : 'Indicator'
-Quirk - duff tag length======================
-MGetWebData
->>>>>>
-Attribute VB_Name = "MGetWebData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Const QueryDataName As String = "ExternalDenmarkData"
-
-Function UpdateHistoryFromWeb(wb As Workbook) As Boolean
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    UpdateHistoryFromWeb = False
-    QryPathStr = GetQryPath(wb)
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW")
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = IsNumeric(.Range("DEN_TIME"))
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table and temp area
-            With .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE))
-                .ClearContents
-                .NumberFormat = "General"
-            End With
-            
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-    
-'            .Parent.Application.DisplayAlerts = False
-    
-            If ResultLength < denWindow Then
-                Exit Function
-            End If
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                OtherChar:="|", _
-                FieldInfo:=Array( _
-                                Array(1, xlSkipColumn), _
-                                Array(2, xlTextFormat), _
-                                Array(3, xlGeneralFormat), _
-                                Array(4, xlGeneralFormat), _
-                                Array(5, xlGeneralFormat), _
-                                Array(6, xlGeneralFormat), _
-                                Array(7, xlGeneralFormat), _
-                                Array(8, xlSkipColumn), _
-                                Array(9, xlSkipColumn), _
-                                Array(10, xlSkipColumn), _
-                                Array(11, xlSkipColumn), _
-                                Array(12, xlSkipColumn))
-            
-            .Range(DestRangeName).EntireColumn.AutoFit
-            
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).NumberFormat = "General"
-            
-            Dim RawData As Range
-            Dim row_idx As Integer
-            
-            Set RawData = .Range(DestRangeName).Offset(0, 1)
-            RawData.Insert Shift:=xlToRight
-            
-            If Not IsIntraday Then
-                Set RawData = RawData.Offset(0, -1)
-                RawData.Value = "18:00"
-                RawData.Cells(1, 1).FormulaR1C1 = "TIME"
-                Set RawData = RawData.Offset(0, -1)
-            Else
-                Set RawData = RawData.Offset(0, -2)
-                RawData.TextToColumns _
-                    Destination:=RawData, _
-                    DataType:=xlDelimited, _
-                    TextQualifier:=xlDoubleQuote, _
-                    ConsecutiveDelimiter:=False, _
-                    Tab:=False, _
-                    Semicolon:=False, _
-                    Comma:=False, _
-                    Space:=True, _
-                    Other:=False, _
-                    OtherChar:="/", _
-                    FieldInfo:=Array( _
-                                    Array(1, xlTextFormat), _
-                                    Array(2, xlTextFormat))
-                RawData.Cells(1, 2).FormulaR1C1 = "TIME"
-            End If
-            
-'            Dim end_date As Date
-'            end_date = RawData.Cells(ResultLength, 1).FormulaR1C1
-
-' Delete unused space
-            
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + ResultLength, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            Dim i As Integer
-' Delete blank intervals
-            
-            Set RawData = .Range(RAW_DATA_RANGE).Offset(0, 0)
-            row_idx = 0
-            For i = 1 To ResultLength
-                ' skip virtual prices
-                If RawData.Offset(row_idx, CLOSE_IDX).Value > MIN_PRICE_VALUE Then
-                    row_idx = row_idx + 1
-                Else
-                    Set Location = .Range( _
-                            .Cells(row_idx + RAW_DATA_RANGE_ROW, DATE_IDX + RAW_DATA_RANGE_COL), _
-                            .Cells(row_idx + RAW_DATA_RANGE_ROW, PROJECT_IDX + RAW_DATA_RANGE_COL) _
-                    )
-                    Location.Delete xlShiftUp
-                End If
-            Next i
-            
-            ResultLength = GetLinesCount(.Range(RAW_DATA_RANGE))
-            
-            row_idx = ResultLength - 1
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).Delete xlShiftUp
-            Else
-                Exit Function
-            End If
-            
-            Dim TmpStr As String
-                        
-            row_idx = GetLinesCount(.Range(RAW_DATA_RANGE))
-            
-            Set RawData = .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx - 1, RAW_DATA_RANGE_COL + DATE_IDX) _
-                )
-            RawData.TextToColumns _
-                Destination:=.Range(RAW_DATA_RANGE).Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="-", _
-                FieldInfo:=Array( _
-                                Array(1, xlTextFormat), _
-                                Array(2, xlTextFormat), _
-                                Array(3, xlTextFormat))
-            
-            Set Location = .Range(RAW_DATA_RANGE).Offset(0, -1)
-            
-            If IsIntraday Then
-                Set RawData = .Range( _
-                            .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + TIME_IDX), _
-                            .Cells(RAW_DATA_RANGE_ROW + row_idx - 1, RAW_DATA_RANGE_COL + TIME_IDX) _
-                    )
-                RawData.TextToColumns _
-                    Destination:=.Range(RAW_DATA_RANGE).Offset(0, TIME_STAMP_OFFSET), _
-                    DataType:=xlDelimited, _
-                    TextQualifier:=xlDoubleQuote, _
-                    ConsecutiveDelimiter:=False, _
-                    Tab:=False, _
-                    Semicolon:=False, _
-                    Comma:=False, _
-                    Space:=False, _
-                    Other:=True, _
-                    OtherChar:=":", _
-                    FieldInfo:=Array( _
-                                    Array(1, xlTextFormat), _
-                                    Array(2, xlTextFormat), _
-                                    Array(3, xlTextFormat))
-                                    
-                
-                For i = 0 To row_idx - 1
-                    Location.Offset(i, 0) = "'" & _
-                            .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 1).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 2).Value _
-                            & "-" & .Range(RAW_DATA_RANGE).Offset(i, TIME_STAMP_OFFSET).Value _
-                            & ":" & .Range(RAW_DATA_RANGE).Offset(i, TIME_STAMP_OFFSET + 1).Value
-                Next
-            Else
-                For i = 0 To row_idx - 1
-                    Location.Offset(i, 0) = "'" & _
-                            .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 2).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 1).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET).Value
-                Next
-            End If
-            .Parent.Application.DisplayAlerts = True
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromWeb = True
-End Function
-
-Private Function GetQryPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    Dim IsIntradai As Boolean
-    Dim DayCount As Integer
-    Const DataFormat As String = "&data_format=BROWSER"
-    With wb.Worksheets(VAR_SHEET)
-        IsIntradai = IsNumeric(.Range("DEN_TIME"))
-        
-        If IsIntradai Then
-        
-            QryPathStr = "URL;http://export.rbc.ru/export/"
-            QryPathStr = QryPathStr & .Range("DEN_SOURCE")
-            QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-            QryPathStr = QryPathStr & "/?"
-            
-            QryPathStr = QryPathStr & "tickers=" & .Range("DEN_SYMBOL")
-            QryPathStr = QryPathStr & "&period=" & .Range("DEN_TIME")
-            QryPathStr = QryPathStr & "&virtual=PASS"
-            DayCount = .Range("DEN_HISTORY") * .Range("DEN_TIME") \ 420 + 1
-            QryPathStr = QryPathStr & "&lastdays=" & DayCount
-            QryPathStr = QryPathStr & "&separator=,"
-            QryPathStr = QryPathStr & DataFormat
-            QryPathStr = QryPathStr & "&header=1"
-        Else
-            QryPathStr = "URL;http://export.rbc.ru/cgi-bin/export/query_version/export.cgi?"
-            QryPathStr = QryPathStr & "&sourcename=" & .Range("DEN_SOURCE")
-            QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-            QryPathStr = QryPathStr & "&tickers=" & .Range("DEN_SYMBOL")
-            QryPathStr = QryPathStr & "&period=DAILY"
-            QryPathStr = QryPathStr & "&virtual=PASS"
-            QryPathStr = QryPathStr & "&lastdays=" & .Range("DEN_HISTORY") + 1
-            QryPathStr = QryPathStr & "&separator=,"
-            QryPathStr = QryPathStr & DataFormat
-            QryPathStr = QryPathStr & "&header=1"
-        End If
-    .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-End Function
-
-Sub UpdateTickerList(wb As Workbook)
-    Dim Idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    QryPathStr = GetListPath(wb)
-    With wb
-        With .Worksheets(VAR_SHEET)
-            Idx = .Range("IDX_DEN_LIST")
-            Set Location = .Range("TICKER_TABLES").Offset(0, (Idx - 1) * 2)
-             .Range("IDX_DEN_SYMBOL") = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-        
-            .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 1), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-        ' Setup Ticker List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        ' Setup Name List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Offset(0, 1).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        .Parent.Application.DisplayAlerts = True
-    End With
-End Sub
-
-Private Function GetListPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://export.rbc.ru/cgi-bin/export/tickers.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-        .Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            ThisWorkbook.Save
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(FORM_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mReadWrite
->>>>>>
-Attribute VB_Name = "mReadWrite"
-Option Explicit
-
-Public Const GOOD_LINE_STATUS As String = "Ok"
-Public Const BAD_LINE_STATUS As String = "N/A"
-
-Function ReadPricesData(Location As Range, Hist As Integer, dt As Integer, _
-              pPriceData As TPriceData) As Integer
-    '������������� ���� TPriceData �� ������� ���� - 1
-    'k��������� �� ����� ��� hist ��������� �����
-    'aPoint - ������ �������
-    '������ ��� ������ ������� �������������� ������ (������)
-    Dim n, i As Integer
-    
-    '����������� ����� ����� ������� - n
-    n = GetLinesCount(Location)
-    ReadPricesData = n
-    If n < 9 Then             '���������� ������ !!!
-        GoTo done
-    End If
-    ' ����� ����� ���������� ()
-    If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-        Hist = (n - 3) \ dt + 1 '
-    End If
-    Dim t, s As Integer
-    For t = 0 To Hist - 1
-        s = n - t * dt - 1
-        pPriceData.D(Hist - t) = Location.Offset(s, DATE_IDX).Value
-        pPriceData.Tm(Hist - t) = Location.Offset(s, TIME_IDX).Value
-        pPriceData.Opn(Hist - t) = Location.Offset(s, OPEN_IDX).Value
-        pPriceData.Hgh(Hist - t) = Location.Offset(s, HIGH_IDX).Value
-        pPriceData.Lw(Hist - t) = Location.Offset(s, LOW_IDX).Value
-        pPriceData.Cls(Hist - t) = Location.Offset(s, CLOSE_IDX).Value
-        pPriceData.Vl(Hist - t) = Location.Offset(s, VOLUME_IDX).Value
-    Next t
-    ReadPricesData = t + 1
-done:
-End Function
-
-Sub ResultLinesOut(Location As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim n As Integer
-    
-    n = GetLinesCount(Location)
-    With Location
-        .Offset(-1, RESIST_IDX) = "Resistance"
-        .Offset(-1, SUPPORT_IDX) = "Support"
-        .Offset(-1, PROJECT_IDX) = "Project"
-    End With
-    Dim t, count, Idx, loc_idx As Integer
-    count = pPD.tC
-    For t = 0 To count - 1
-        Idx = count - t
-        loc_idx = n - t - 1
-        If pDen.ResistanceLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, RESIST_IDX).Value = pDen.ResistanceLine(Idx)
-        End If
-        If pDen.SupportLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, SUPPORT_IDX).Value = pDen.SupportLine(Idx)
-        End If
-        If Abs(pDen.SignalValue) > 1 Then
-            Location.Offset(loc_idx, PROJECT_IDX).Value = pDen.ProjectPrice
-        End If
-    Next t
-End Sub
-
-Sub Out_Table_1(TheRange As Range, pDen As TDenmark, LastIdx As Integer)
-    
-    
-    ' Col = 2 - �� ��������� !!!
-    ' Status - Col = 0
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(0, 0).Value = BAD_LINE_STATUS
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(1, 0).Value = BAD_LINE_STATUS
-    End If
-    ' -----------------------------------------
-    ' ���� �������� ����� ������������� � ��������� - Col = 1
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 1).Value = pDen.ResistanceAngle
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 1).Value = pDen.SupportAngle
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 1).Value = (pDen.ResistanceAngle + pDen.SupportAngle) / 2
-    End If
-    ' -----------------------------------------
-    ' ������� ���� ����� �������� �� ������� ������
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 2).Value = pDen.ResistanceLine(LastIdx)
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 2).Value = pDen.SupportLine(LastIdx)
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 2).Value = _
-            (pDen.ResistanceLine(LastIdx) + pDen.SupportLine(LastIdx)) / 2
-    End If
-    
-End Sub
-
-Sub Out_Table_2(TheRange As Range, TheComment As Range, pPD As TPriceData, pDen As TDenmark)
-    Const ColorIndexBUY = 5
-    Const ColorIndexSELL = 3
-    Const ColorIndexNOTHINK = 14
-    
-    Dim SignalValue_defined, allert_enable  As Boolean
-    Dim Message As String
-    SignalValue_defined = False
-    allert_enable = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_ALLERT_DLG")
-    Message = "������ �� ��������� ������ �� ���������������."
-    If pDen.SignalValue >= 2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "BUY"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexBUY
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue - 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "BUY Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & pDen.SignalValue - 1 & " ! "
-    End If
-    If pDen.SignalValue <= -2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "SELL"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexSELL
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue + 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "SELL Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(pDen.SignalValue + 1) & "!"
-    End If
-    With TheComment
-        .Value = Message
-        .Font.Bold = True
-        Dim color_idx As Integer
-        If SignalValue_defined Then
-            If pDen.SignalValue > 0 Then
-                .Font.ColorIndex = ColorIndexBUY
-            Else
-                .Font.ColorIndex = ColorIndexSELL
-            End If
-        Else
-            .Font.ColorIndex = ColorIndexNOTHINK
-        End If
-    End With
-    If allert_enable And SignalValue_defined Then
-        MsgBox _
-            Prompt:=Message, _
-            Title:=PROGRAM_NAME, _
-            Buttons:=vbOKOnly + vbInformation
-    End If
-End Sub
-
-Sub Out_Table_3(TheRange As Range, pDen As TDenmark)
-    Dim i As Integer
-    For i = 1 To 3
-        TheRange.Offset(i - 1, 0).Value = pDen.Qualificator(i)
-    Next i
-End Sub
-
-Sub Out_Table_4(TheRange As Range, pPD As TPriceData)
-    Dim LastIdx As Integer
-    LastIdx = pPD.tC
-    With TheRange
-        .Offset(0, 0).Value2 = "'" & pPD.D(LastIdx)
-        .Offset(0, 1).Value2 = "'" & pPD.Tm(LastIdx)
-        .Offset(0, 2) = pPD.Opn(LastIdx)
-        .Offset(0, 3) = pPD.Hgh(LastIdx)
-        .Offset(0, 4) = pPD.Lw(LastIdx)
-        .Offset(0, 5) = pPD.Cls(LastIdx)
-        .Offset(0, 6) = pPD.Cls(LastIdx) - pPD.Cls(LastIdx - 1)
-    End With
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Denmark method bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-    End With
-    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(wb As Workbook)
-    With wb
-        .Application.ScreenUpdating = False
-        
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(FORM_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-            .Select
-        End With
-        With .Worksheets(CHART_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-        End With
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(wb As Workbook)
-    With wb
-        .Unprotect
-        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Unprotect
-        End With
-        With .Worksheets(FORM_SHEET)
-            .Select
-            .Unprotect
-        End With
-        .Application.ScreenUpdating = True
-        
-    End With
-End Sub
-
-<<<<<<
-======================
-mTypes
->>>>>>
-Attribute VB_Name = "mTypes"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "������ ����������� ���������"
-Public Const PROGRAM_VERSION As String = "version 1.0"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-Public Const ESTIMATION_DATE As Long = 20010615
-'Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "J27"
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const PRICE_TABLE As String = "B1"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-Public Const VAR_SHEET As String = "Var_s"
-
-Public Const CHART_SHEET As String = "Chart"
-
-Public Const MIN_PRICE_VALUE As Double = 0.000001
-Public Const MAX_PRICE_VALUE As Double = 1000000000
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const HIGH_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const CLOSE_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const RESIST_IDX As Integer = 7
-Public Const SUPPORT_IDX As Integer = 8
-Public Const PROJECT_IDX As Integer = 9
-
-Public Const DATE_STAMP_OFFSET = PROJECT_IDX + 1
-Public Const TIME_STAMP_OFFSET = PROJECT_IDX + 4
-Public Const DATE_TIME_STAMP_SIZE = 5
-
-Type TPriceData
-    D() As String      ' ����������� ����
-    Tm() As String     ' �����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Double     ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type TDenmark
-   ResistanceLine() As Double           'Resistance line
-   ResistancePoints() As Integer        'Resistance pivot points
-   ResistancePointCount As Integer      'The number of resistance pivot points
-   ResistanceAngle As Double            'Angle of Declination of ResistanceLine
-   
-   SupportLine() As Double              'Support line
-   SupportPoints() As Integer           'Support pivot points
-   SupportPointsCount As Integer        'The number of support pivot points
-   SupportAngle As Double               ' Angle of Declination of SupportLine
-   
-   SignalParameter     As Integer       ' parameter for SignalValue
-   SignalValue      As Integer          'SignalValue
-   
-   
-   Qualificator(1 To 3) As String       ' qualificators
- 
-   ProjectNumber As Integer             ' ����� ��������
-   ProjectPrice  As Double              ' �������� ����
-   
-End Type
-
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-Dim AppRunEnable As New cEnableRun
-
-Sub evParamChange()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = True Then
-        evSubmit_Click
-    End If
-End Sub
-
-Sub cmViewChart(Optional SwapPage As Boolean = True)
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_CHART_READY") = False
-        If .Range("BOOL_DEMARK_READY") <> True Then
-            If .Range("BOOL_AUTORECALC") = True Then
-                evSubmit_Click
-                If .Range("BOOL_DEMARK_READY") <> True Then
-                    Exit Sub
-                End If
-            Else
-                MsgBox _
-                    "������ �� ����� ���� ��������." & vbCrLf & "�������� ������ �� ����������.", _
-                    vbOKOnly + vbExclamation, _
-                    PROGRAM_NAME
-                Exit Sub
-            End If
-        End If
-    End With
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        With .Range("TABLE_1")
-            Dim test_lines As Boolean
-            test_lines = StrComp(.Cells(1, 1).Value, GOOD_LINE_STATUS)
-            test_lines = test_lines + StrComp(.Cells(2, 1).Value, GOOD_LINE_STATUS)
-            If test_lines <> 0 Then
-                MsgBox _
-                    Prompt:="������ �� ����� ���� ��������." & vbCrLf & "������� ����� �� ���������� .", _
-                    Title:=PROGRAM_NAME, _
-                    Buttons:=vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End With
-        Draw_Chart Not IsEmpty(.Range("TABLE_2").Cells(1, 1))
-    End With
-    With ThisWorkbook
-        .Worksheets(VAR_SHEET).Range("BOOL_CHART_READY") = True
-        If SwapPage Then
-            .Worksheets(CHART_SHEET).Select
-        End If
-    End With
-End Sub
-
-Sub cmViewForm()
-    With ThisWorkbook
-        .Worksheets(FORM_SHEET).Select
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Dim ResistanceLine
-    ResistanceLine = MsgBox( _
-        Prompt:="�� ������� ��������� ���������?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If ResistanceLine = vbYes Then
-       Application.Quit
-    End If
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Demark.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable wb:=ThisWorkbook
-    SetEnvironment wb:=ThisWorkbook
-    ProtectionEnable wb:=ThisWorkbook
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable wb:=ThisWorkbook
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=True
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmPrint()
-    If MsgBox( _
-            Prompt:="�� ������� ����������� ���������?", _
-            Buttons:=vbYesNo + vbQuestion, _
-            Title:=PROGRAM_NAME) = vbNo _
-    Then
-        Exit Sub
-    End If
-    Dim s_ticker, s_name, s_time As String
-    s_ticker = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME")
-    s_name = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_NAME")
-    s_time = Now
-    Application.ScreenUpdating = False
-    cmViewChart SwapPage:=False
-    Application.ScreenUpdating = False
-    With ThisWorkbook.Worksheets(FORM_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    With ThisWorkbook.Worksheets(CHART_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    Application.ScreenUpdating = False
-    ThisWorkbook.Worksheets(Array("MainForm", "Chart")).PrintOut Copies:=1, Collate:=True
-    cmViewForm
-End Sub
-<<<<<<
-======================
-mDemark
->>>>>>
-Attribute VB_Name = "mDemark"
-Option Explicit
-
-Public Const FORM_SHEET As String = "MainForm"
-
-'Form Ranges
-Public Const FILE_NAME As String = "FILE_NAME"
-Public Const TABLE_1 As String = "TABLE_1"
-Public Const TABLE_2 As String = "TABLE_2"
-Public Const TABLE_3 As String = "TABLE_3"
-Public Const TABLE_4 As String = "TABLE_4"
-Public Const TABLE_COMMENT As String = "TABLE_COMMENT"
-
-'�������� ��� ������ - �������� 1
-
-'*********************
-Dim PriceDataArray As TPriceData
-Dim DenmarkDataArray As TDenmark
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Sub ClearResultTables()
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        .Range(TABLE_1).ClearContents ' �������-1
-        .Range(TABLE_2).ClearContents ' �������-2
-        .Range(TABLE_3).ClearContents ' �������-3
-        .Range(TABLE_COMMENT).Value = "" ' ����������-3
-        .Range(TABLE_4).ClearContents ' �������-4
-    End With
-End Sub
-
-Function TDenmark_Calc() As Boolean
-    
-    Dim nWindow As Integer
-    Dim bPrevCloseFilter, bSuccCloseFilter As Boolean
-    
-    TDenmark_Calc = False
-    
-    mobjAppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-'1)    Read User data
-        With .Worksheets(VAR_SHEET)
-            DenmarkDataArray.ProjectNumber = .Range("DEN_PROECT").Value
-            DenmarkDataArray.SignalParameter = .Range("DEN_PARAM").Value
-            nWindow = .Range("DEN_WINDOW").Value
-            bPrevCloseFilter = .Range("BOOL_PREV_CLOSE").Value
-            bSuccCloseFilter = .Range("BOOL_SUCC_CLOSE").Value
-        End With
-
-'2)   Memory allocation
-        allocate_memory PriceDataArray, DenmarkDataArray, nWindow
-
-'3)   Read data
-        Dim TheRange As Range
-        Set TheRange = .Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE)
-        Dim LinesCount As Integer
-        LinesCount = ReadPricesData(Location:=TheRange, Hist:=PriceDataArray.tC, dt:=1, pPriceData:=PriceDataArray)
-        
-        'Init function result
-        TDenmark_Calc = LinesCount >= nWindow
-        
-        If LinesCount >= nWindow Then
-        
-'4)   Calculate metod TDenmarkDataArray
-            DetDenmark PriceDataArray, DenmarkDataArray, bPrevCloseFilter, bSuccCloseFilter
-            If Abs(DenmarkDataArray.SignalValue) > 1 Then  '������� ���������, ���� ���� ������
-                DetProj PriceDataArray, DenmarkDataArray
-            End If
-'5)   Write result
-            Application.ScreenUpdating = False
-    
-'6)    Clear interface tables
-            ClearResultTables
-            
-            ResultLinesOut Location:=TheRange.Offset(2, 0), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-            
-            With .Worksheets(FORM_SHEET)
-                Out_Table_1 TheRange:=.Range(TABLE_1).Cells(1, 1), pDen:=DenmarkDataArray, LastIdx:=PriceDataArray.tC
-                Out_Table_2 _
-                        TheRange:=.Range(TABLE_2).Cells(1, 1), _
-                        TheComment:=.Range("TABLE_COMMENT"), _
-                        pPD:=PriceDataArray, _
-                        pDen:=DenmarkDataArray
-                Out_Table_3 TheRange:=.Range(TABLE_3).Cells(1, 1), pDen:=DenmarkDataArray
-                Out_Table_4 TheRange:=.Range(TABLE_4).Cells(1, 1), pPD:=PriceDataArray
-                With .Range(TABLE_1)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_2)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_3)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_4)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-            End With
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = True
-        Else
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-'7)   Free unused memory
-        free_unused_memory PriceDataArray, DenmarkDataArray
-    End With
-End Function
-
-Sub allocate_memory(pPriceData As TPriceData, pDenmarkData As TDenmark, memsize As Integer)
-'  ������ ��� TDenmark
-    ReDim pDenmarkData.ResistanceLine(1 To memsize)
-    ReDim pDenmarkData.ResistancePoints(1 To memsize)
-    ReDim pDenmarkData.SupportLine(1 To memsize)
-    ReDim pDenmarkData.SupportPoints(1 To memsize)
-   
-' ������������� ������ �� �����
-    pPriceData.tC = memsize
-    ReDim pPriceData.D(1 To memsize)
-    ReDim pPriceData.Tm(1 To memsize)
-    ReDim pPriceData.Opn(1 To memsize)
-    ReDim pPriceData.Hgh(1 To memsize)
-    ReDim pPriceData.Lw(1 To memsize)
-    ReDim pPriceData.Cls(1 To memsize)
-    ReDim pPriceData.Vl(1 To memsize)
-
-End Sub
-
-Sub free_unused_memory(pP As TPriceData, pD As TDenmark)
-'   Free Prices
-    pP.tC = 0
-    Erase pP.D
-    Erase pP.Tm
-    Erase pP.Opn
-    Erase pP.Hgh
-    Erase pP.Lw
-    Erase pP.Cls
-    Erase pP.Vl
-    
-'Free TDenmark
-    Erase pD.ResistanceLine
-    Erase pD.ResistancePoints
-    Erase pD.SupportLine
-    Erase pD.SupportPoints
-End Sub
-
-
-'*****************************************
-Sub DetDenmark(pPriceData As TPriceData, pDenmarkData As TDenmark, ByVal ClosePrev2 As Boolean, ByVal CloseSucc1 As Boolean)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPriceData  - ����, ����������� ����� ������ �� ����� (����������)
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' pDenmarkData - �������� ������ �������� (������ ��������, SignalParameter - ���������):
-' ����� ResistanceLine,SupportLine �� �������, ������� �����, ������� � ������� ��� �������
-' SignalValue = 0 ������ �����������
-' SignalValue < 0 ������ ����������� ������ (������ �������)
-' SignalValue > 0 ������ ����������� ������ (������ �������)
-' ���� pDenmarkData.ResistancePointCount < 2, �� �������� ResistanceLine �� ������������
-' ���� pDenmarkData.SupportPointsCount < 2, �� �������� SupportLine �� ������������
-
-' ��������� ���������
-    Const QUALIFICATOR_DISABLE As String = "-"
-    Const QUALIFICATOR_ENABLE As String = "Signal"
-    
-    Dim UpQual(1 To 3) As String
-    Dim DownQual(1 To 3) As String
-    Dim UpSignal, DownSignal As Integer
-    Dim i As Integer
-    
-    pDenmarkData.SignalValue = 0
-    UpSignal = 0
-    DownSignal = 0
-    
-    For i = 1 To 3
-        pDenmarkData.Qualificator(i) = QUALIFICATOR_DISABLE
-        UpQual(i) = QUALIFICATOR_DISABLE
-        DownQual(i) = QUALIFICATOR_DISABLE
-    Next i
-    
-' ����������� ����� ��������� � �������������
-    ResLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.ResistancePointCount, _
-        pDenmarkData.ResistanceLine, _
-        pDenmarkData.ResistancePoints, _
-        ClosePrev2, _
-        CloseSucc1
-        
-    SuppLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.SupportPointsCount, _
-        pDenmarkData.SupportLine, _
-        pDenmarkData.SupportPoints, _
-        ClosePrev2, _
-        CloseSucc1
-
-        
-        
-    If pDenmarkData.ResistancePointCount >= 2 Then
-        pDenmarkData.ResistanceAngle = 57.29578 * _
-            Atn(pDenmarkData.ResistanceLine(pPriceData.tC) - _
-                pDenmarkData.ResistanceLine(pPriceData.tC - 1))
-    End If
-    If pDenmarkData.SupportPointsCount >= 2 Then
-        pDenmarkData.SupportAngle = 57.29578 * _
-            Atn(pDenmarkData.SupportLine(pPriceData.tC) - _
-                pDenmarkData.SupportLine(pPriceData.tC - 1))
-    End If
-
-' ������������ ������� ----------------------------------
-    Dim t As Integer
-' 1. ������ ����������� ������: ResistanceLine ��������� � ResistanceLine ������ *************
-    If pDenmarkData.ResistancePointCount >= 2 And pDenmarkData.ResistanceAngle < 0 Then
-'    ����������� ������� ������� �����
-        If pDenmarkData.ResistanceLine(pPriceData.tC) < pPriceData.Cls(pPriceData.tC) Then
-            UpSignal = 1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) > pDenmarkData.ResistanceLine(t) Then
-                    UpSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If UpSignal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) > pPriceData.Cls(pPriceData.tC - 1) Then
-                UpSignal = UpSignal + 1
-                UpQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: open > ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) > pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - demand value < ResistanceLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Lw(pPriceData.tC - 1) < pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-    End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: SupportLine ��������� � SupportLine ������
-    If pDenmarkData.SupportPointsCount >= 2 And pDenmarkData.SupportAngle > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-        If pPriceData.Cls(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-            DownSignal = -1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) < pDenmarkData.SupportLine(t) Then
-                    DownSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If DownSignal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) < pPriceData.Cls(pPriceData.tC - 1) Then
-                DownSignal = DownSignal - 1
-                DownQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: Open ���� ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - supply value(t-1) > SupportLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Hgh(pPriceData.tC - 1) > pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-'    ---------------------------------------------
-    End If
-'      ���������� ������������ ���������
-    If Abs(DownSignal) <> UpSignal Then
-        If Abs(DownSignal) > UpSignal Then
-            pDenmarkData.SignalValue = DownSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = DownQual(i)
-            Next i
-        Else
-            pDenmarkData.SignalValue = UpSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = UpQual(i)
-            Next i
-        End If
-    End If
-End Sub
-
-Sub DetProj(pPriceData As TPriceData, pDenmarkData As TDenmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-    Dim pM As Double, t As Integer, Tm As Integer, tL As Integer
-
-    If pDenmarkData.SignalValue >= 2 Then  ' ������ �������
-
-        tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount)     ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2 Then
-'           t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < ResistanceLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Lw(Tm) ' L(t-1) < ResistanceLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Lw(t) < pM And pPriceData.Lw(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Lw(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
-'               P1( tb) = ResistanceLine(tb) + ResistanceLine(t*) - L(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Lw(Tm)
-            Else
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If ' pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < ResistanceLine(t)}
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Cls(t) < pM And pPriceData.Cls(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue >= 2
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-    If pDenmarkData.SignalValue <= -2 Then
-        tL = pDenmarkData.SupportPoints(pDenmarkData.SupportPointsCount)  ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.SupportPointsCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber = 1 Or pDenmarkData.ProjectNumber = 2 Then
-'           t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > SupportLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Hgh(Tm) ' H(t-1) > SupportLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Hgh(t) > pM And pPriceData.Hgh(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Hgh(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
- '              P1( tb) = SupportLine(tb) + SupportLine(t*) - H(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Hgh(Tm)
-            Else
-'               P2( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  SupportLine(t)}
-'           P3( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pM < pPriceData.Cls(t) And pPriceData.Cls(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue <= -2
-End Sub
-
-Sub ResLine(pP As TPriceData, tE As Integer, ResistancePointCount As Integer, _
-            ResistanceLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� ResistanceLine, dom(ResistanceLine)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(ResistancePointCount)}, s(1) < s(2) < ...< s(ResistancePointCount)
-'   ( s(ResistancePointCount)<= tE )- ������� �����
-' 3) ����� ������� ����� ResistancePointCount.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� SupportLine
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-  
-'1 ����������� ������� �������� �������
-    ResistancePointCount = 0
-    For t = 3 To tE - 1
- '      v = max{high(t-1), high(t+1)} < high(t)}
-        v = pP.Hgh(t - 1)
-        If v < pP.Hgh(t + 1) Then
-            v = pP.Hgh(t + 1)
-        End If
-        IsGoodPoint = pP.Hgh(t) > v
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) < pP.Hgh(t))
-        End If
-        
-        If IsGoodPoint Then       'alt.: v >= High(t + 1)
-            s(ResistancePointCount + 1) = t: ResistancePointCount = ResistancePointCount + 1
-        End If
-    Next t
-    
-loop_:
-    
-    If ResistancePointCount < 2 Then
-        GoTo done
-    End If
-
-' 2 ����������� ����� �������������
-    ResistanceLine(s(1)) = pP.Hgh(s(1))
-    For i = 2 To ResistancePointCount
-        ResistanceLine(s(i)) = pP.Hgh(s(i))
-        v = (pP.Hgh(s(i)) - pP.Hgh(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            ResistanceLine(t) = pP.Hgh(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(ResistancePointCount) < tE Then
-        v = (pP.Hgh(s(ResistancePointCount)) - pP.Hgh(s(ResistancePointCount - 1))) / (s(ResistancePointCount) - s(ResistancePointCount - 1))
-        For t = s(ResistancePointCount) + 1 To tE
-            ResistanceLine(t) = pP.Hgh(s(ResistancePointCount - 1)) + v * (t - s(ResistancePointCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To ResistancePointCount
-            If ResistanceLine(s(t) + 1) < pP.Cls(s(t) + 1) Then
-                ResistancePointCount = ResistancePointCount - 1
-                ' ������� �����
-                For i = t To ResistancePointCount
-                    s(i) = s(i + 1)
-                Next i
-                s(ResistancePointCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(ResistanceLine)
-                Rb = UBound(ResistanceLine)
-                Erase ResistanceLine
-                ReDim ResistanceLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-    
-done:
-End Sub
-
-Sub SuppLine(pP As TPriceData, tE As Integer, SupportPointsCount As Integer, _
-               SupportLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� SupportLine, dom(SupportLine)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(SupportPointsCount)}, s(1) < s(2) < ...< s(SupportPointsCount) -
-'    ������� �����
-' 3) ����� ������� ����� SupportPointsCount.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-    
-'1 ����������� ������� �������� �������
-     SupportPointsCount = 0
-    For t = 3 To tE - 1
-'       v = min{Low(t-1), Low(t+1)} > Low(t)
-        v = pP.Lw(t - 1)
-        If v > pP.Lw(t + 1) Then
-            v = pP.Lw(t + 1)
-        End If
-        
-        IsGoodPoint = pP.Lw(t) < v
-        
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) > pP.Lw(t))
-        End If
-        
-        If IsGoodPoint Then     'alt.: v >= High(t + 1)
-            s(SupportPointsCount + 1) = t: SupportPointsCount = SupportPointsCount + 1
-        End If
-    Next t
-
-loop_:
-    If SupportPointsCount < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� ���������
-    
-    SupportLine(s(1)) = pP.Lw(s(1))
-    For i = 2 To SupportPointsCount
-        SupportLine(s(i)) = pP.Lw(s(i))
-        v = (pP.Lw(s(i)) - pP.Lw(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            SupportLine(t) = pP.Lw(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(1) < tE Then
-        v = (pP.Lw(s(SupportPointsCount)) - pP.Lw(s(SupportPointsCount - 1))) / (s(SupportPointsCount) - s(SupportPointsCount - 1))
-        For t = s(SupportPointsCount) + 1 To tE
-            SupportLine(t) = pP.Lw(s(SupportPointsCount - 1)) + v * (t - s(SupportPointsCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To SupportPointsCount
-            If SupportLine(s(t) + 1) > pP.Cls(s(t) + 1) Then
-                SupportPointsCount = SupportPointsCount - 1
-                ' ������� �����
-                For i = t To SupportPointsCount
-                    s(i) = s(i + 1)
-                Next i
-                s(SupportPointsCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(SupportLine)
-                Rb = UBound(SupportLine)
-                Erase SupportLine
-                ReDim SupportLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-done:
-End Sub
-
-<<<<<<
-======================
-mChart
->>>>>>
-Attribute VB_Name = "mChart"
-Option Explicit
-
-Const CHART_NAME As String = "PriceChart"
-
-Sub Draw_Chart(SignalDefined As Boolean)
-
-    Dim n As Integer
-    Dim theChart As Chart
-    Dim ChartDataAria, szLastNumber As String
-    Dim MinYScale As Double
-    
-    
-    With ThisWorkbook
-' Checking data
-' Disable screen out
-        .Application.Cursor = xlWait
-        .Application.ScreenUpdating = False
-' Create series range
-        n = GetLinesCount(Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE))
-        szLastNumber = n + 1
-        If SignalDefined Then
-            ChartDataAria = "A2:A" & szLastNumber _
-                        & ",D2:D" & szLastNumber _
-                        & ",G2:G" & szLastNumber _
-                        & ",I2:K" & szLastNumber
-        Else
-            ChartDataAria = "A2:A" & szLastNumber _
-                        & ",D2:D" & szLastNumber _
-                        & ",G2:G" & szLastNumber _
-                        & ",I2:J" & szLastNumber
-        End If
-        MinYScale = GetMinValue(.Worksheets(RAW_DATA_SHEET).Range(ChartDataAria))
-' Find and delete old chart
-        .Worksheets(CHART_SHEET).Unprotect
-        Dim WindowWidth, WindowHeight As Integer
-        With .Worksheets(CHART_SHEET)
-            WindowWidth = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            WindowHeight = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-        
-        
-        With .Worksheets(CHART_SHEET).ChartObjects
-            .Delete
-            With .Add(5, 5, WindowWidth - 10, WindowHeight - 10)
-                .SendToBack
-                Set theChart = .Chart
-            End With
-' Create a chart
-        End With
-        With theChart
-            .ChartType = xlLine
-            .SetSourceData Source:=Sheets(RAW_DATA_SHEET).Range( _
-                    ChartDataAria), PlotBy:=xlColumns
-'                   .Location Where:=xlLocationAsObject, Name:=CHART_SHEET
-            .HasTitle = True
-            With .ChartTitle
-                .Text = ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE).Value
-                With .Font
-                    .Size = 8
-                    .Bold = True
-                End With
-            End With
-            .HasLegend = True
-            With .Legend
-                .Position = xlTop
-                With .Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            .HasDataTable = False
-            With .Axes(xlCategory)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                .TickLabels.Orientation = xlUpward
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .CrossesAt = 1
-                .TickLabelSpacing = 1
-                .TickMarkSpacing = 1
-                .AxisBetweenCategories = False
-                .ReversePlotOrder = False
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            With .Axes(xlValue)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .MinimumScale = MinYScale
-                .MaximumScaleIsAuto = True
-                .MinorUnitIsAuto = True
-                .MajorUnitIsAuto = True
-                .Crosses = xlCustom
-                .CrossesAt = MinYScale
-                .ReversePlotOrder = False
-                .ScaleType = xlLinear
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            .ChartTitle.Top = 5
-            .ChartTitle.Left = 5
-            With .Legend
-                .Top = 5
-                .Fill.OneColorGradient _
-                    Style:=msoGradientHorizontal, _
-                    Variant:=3, _
-                    Degree:=0.303913939116503
-                .Fill.Visible = True
-                .Fill.ForeColor.SchemeColor = 71
-            End With
-            .PlotArea.Left = 10
-            .PlotArea.Top = .Legend.Top + .Legend.Height + 5
-            .PlotArea.Width = .ChartArea.Width - 20
-            .PlotArea.Height = .ChartArea.Height - .PlotArea.Top
-            
-' Tune OPEN line
-            With .SeriesCollection(1)
-                .Border.LineStyle = xlNone
-                .MarkerBackgroundColorIndex = xlNone
-                .MarkerForegroundColorIndex = 1
-                .MarkerStyle = xlPlus
-                .Smooth = False
-                .MarkerSize = 9
-                .Shadow = False
-            End With
-' Tune CLOSE line
-            With .SeriesCollection(2)
-                .Border.ColorIndex = 10
-                .Border.Weight = xlMedium
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune RESISTANCE line
-            With .SeriesCollection(3)
-                .Border.ColorIndex = 3
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune SUUPORT line
-            With .SeriesCollection(4)
-                .Border.ColorIndex = 25
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-            If SignalDefined Then
-                With .SeriesCollection(5)
-                    .Border.ColorIndex = 6
-                    .Border.Weight = xlThin
-                    .Border.LineStyle = xlDot
-                End With
-            End If
-        End With
-        .Application.Cursor = xlDefault
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Protect userInterfaceOnly:=True
-        End With
-    End With
-End Sub
-
-Function GetMinValue(DataRange As Range) As Double
-    Dim Cell As Range
-    Dim MinValue, MaxValue, RangeValue, CorrectValue, Mult As Double
-    MinValue = MAX_PRICE_VALUE
-    MaxValue = MIN_PRICE_VALUE
-    For Each Cell In DataRange
-        If Not IsEmpty(Cell) And IsNumeric(Cell) Then
-            If Cell > MIN_PRICE_VALUE Then
-                If Cell < MinValue Then
-                    MinValue = Cell
-                End If
-                If Cell > MaxValue Then
-                    MaxValue = Cell
-                End If
-            End If
-        End If
-    Next
-    RangeValue = MaxValue - MinValue
-    If RangeValue < 0 Then
-        MinValue = 0
-    Else
-        CorrectValue = RangeValue / 4
-        Mult = MIN_PRICE_VALUE
-        While MinValue - Int(MinValue * Mult) / Mult > CorrectValue
-            Mult = Mult * 10
-        Wend
-        MinValue = Int(MinValue * Mult) / Mult
-    End If
-    GetMinValue = MinValue
-End Function
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{7596B8A3-31DF-4FA6-9CFD-63E745FC3A75}{E2D0F726-1F87-4336-9895-B0FC73E95498}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-mWebQeury
->>>>>>
-Attribute VB_Name = "mWebQeury"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .Name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.Name = QryName Then
-            WebQuery.Delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.Name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-Attribute CreateCommandBar.VB_ProcData.VB_Invoke_Func = "R\n14"
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Contents"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 49
-                        .OnAction = "cmHelpContents"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mTool
->>>>>>
-Attribute VB_Name = "mTool"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub tool_delete_all_tables()
-    QryDelete ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range("A1")
-End Sub
-
-Sub tool_delete_all_charts(theSheet As Worksheet)
-    Dim theChart As Chart
-    For Each theChart In theSheet
-        theChart.Unprotect
-        theChart.Delete
-    Next
-End Sub
-
-Sub DateTimeTest()
-    Dim the_date
-    Dim the_time
-    the_date = DateValue(Now)
-    the_time = TimeValue(Now)
-End Sub
-
-
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{122F0FA6-6A60-45B6-9F0E-0CE00712999B}{7C2DD166-FCE9-4666-A2DB-2FDD36929C39}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-
-Private Sub App_WorkbookOpen(ByVal wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.count > 1 Then
-        wbname = wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-mDataCommands
->>>>>>
-Attribute VB_Name = "mDataCommands"
-Option Explicit
-
-Sub evFileOpen()
-    Dim fileToOpen As String
-    Dim wb As Workbook
-    Dim ticker As String
-    Dim Result As Integer
-
-    fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
-    Set wb = ThisWorkbook
-    With wb
-        If fileToOpen <> "False" Then
-            If .Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = True Then
-                .Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = False
-            End If
-            .Worksheets(FORM_SHEET).Range(FILE_NAME) = fileToOpen
-            Result = UpdateHistoryFromFile(wb, fileToOpen)
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            
-            ClearResultTables
-            
-            Select Case Result
-                Case FUNCRES_FILE_OK
-                    .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = True
-                    If TDenmark_Calc Then
-                        With .Worksheets(RAW_DATA_SHEET)
-                            ticker = .Range("B1")
-                        End With
-                        With .Worksheets(FORM_SHEET)
-                            .Range("CALC_TICKER_NAME") = ticker
-                        End With
-                    End If
-                Case FUNCRES_FILE_VERY_SMALL
-                    .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_VERY_SMALL
-                    MsgBox MSG_FILE_VERY_SMALL, vbOKOnly, PROGRAM_NAME
-                Case FUNCRES_FILE_INVALID_FORMAT
-                    .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_INVALID_FORMAT
-                    MsgBox MSG_FILE_INVALID_FORMAT, vbOKOnly, PROGRAM_NAME
-                End Select
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-    End With 'wb
-End Sub
-
-Sub evSubmit_Click()
-    Dim ticker As String
-    Dim Period As String
-
-    Application.Cursor = xlWait
-    Dim wb As Workbook
-    Set wb = ThisWorkbook
-    With wb
-        With .Worksheets(VAR_SHEET)
-            ticker = .Range("DEN_SYMBOL")
-            Period = .Range("DEN_TIME")
-            If .Range("BOOL_DATA_READY") = False Or .Range("BOOL_LOAD_DATA") = True Then
-                .Range("BOOL_DATA_READY") = UpdateHistoryFromWeb(wb)
-            End If
-            .Range("BOOL_DEMARK_READY") = False
-        End With
-        If .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False Then
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            
-            ClearResultTables
-            
-            With .Worksheets(FORM_SHEET)
-                .Range("CALC_TICKER_NAME") = ticker & ", Period=" & Period
-                .Range("FILE_NAME") = ""
-                .Range(TABLE_COMMENT).Value = "������������ ������"
-            End With
-        Else
-            If TDenmark_Calc Then
-                With .Worksheets(FORM_SHEET)
-                    .Range("CALC_TICKER_NAME") = ticker & ", Period=" & Period
-                    .Range("FILE_NAME") = ""
-                End With
-            End If
-        End If
-    End With
-    Application.Cursor = xlDefault
-End Sub
-
-Sub evTicker_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SECNAME") = .Range("IDX_DEN_SYMBOL")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evSecName_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SYMBOL") = .Range("IDX_DEN_SECNAME")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evLastInterval_Change()
-    MsgBox "�� �������� � ���� ������"
-End Sub
-
-Sub evHistory_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_DATA_READY") = False
-    End With
-End Sub
-
-Sub evGroupChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        GroupIdx = .Range("IDX_DEN_LIST")
-        .Range("IDX_DEN_SYMBOL") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat.ListFillRange = NewCbxRange
-        NewRangeOffsetCol = NewRangeOffsetCol + 1
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat.ListFillRange = NewCbxRange
-    End With
-    evTicker_Change
-End Sub
-
-Sub evUpdateTickerList()
-    UpdateTickerList ThisWorkbook
-    evHistory_Change
-End Sub
-<<<<<<
-======================
-mGetFileData
->>>>>>
-Attribute VB_Name = "mGetFileData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Public Const MAX_LOAD_DATA_LINES As Integer = 16000
-
-Public Const MSG_FILE_VERY_SMALL As String = "� ����� ������������ ������"
-Public Const MSG_FILE_INVALID_FORMAT As String = "�������� ������ �����"
-
-Public Const FUNCRES_FILE_OK As Integer = 0
-Public Const FUNCRES_FILE_VERY_SMALL As Integer = -1
-Public Const FUNCRES_FILE_INVALID_FORMAT As Integer = -2
-
-Function UpdateHistoryFromFile(wb As Workbook, fileToOpen As String) As Integer
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    Dim SingleFileLine As String
-    Dim FileHandler As Integer
-    Dim i, j, row_idx As Integer
-    
-    UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = True
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            'Clear table include temp area
-            .Parent.Application.DisplayAlerts = False
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            
-            ' Reading data from file
-            FileHandler = FreeFile
-            row_idx = 0
-            Open fileToOpen For Input As #FileHandler
-            Do While Not EOF(FileHandler) And row_idx < MAX_LOAD_DATA_LINES
-                Line Input #FileHandler, SingleFileLine
-                .Range(PRICE_TABLE).Offset(row_idx, 0) = SingleFileLine
-                row_idx = row_idx + 1
-            Loop
-            Close #FileHandler
-            
-            ' Parsing data
-            DestRangeName = "=" & RAW_DATA_SHEET & "!$B$1:$B" & row_idx
-            ResultLength = row_idx
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-            .Parent.Application.DisplayAlerts = True
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            
-            If Not CheckFileFormat(RawData.Offset(-1, 0)) Then
-                UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-                Exit Function
-            End If
-            
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).Delete xlShiftUp
-            Else
-                UpdateHistoryFromFile = FUNCRES_FILE_VERY_SMALL
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).Delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromFile = FUNCRES_FILE_OK
-End Function
-
-Function CheckFileFormat(HeaderString As Range) As Boolean
-    With HeaderString
-        CheckFileFormat = _
-            .Offset(0, DATE_IDX) = "Date" And _
-            .Offset(0, TIME_IDX) = "Time" And _
-            .Offset(0, OPEN_IDX) = "Open" And _
-            .Offset(0, CLOSE_IDX) = "Close" And _
-            .Offset(0, LOW_IDX) = "Low" And _
-            .Offset(0, HIGH_IDX) = "High" And _
-            .Offset(0, VOLUME_IDX) = "Volume"
-    End With
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module2
->>>>>>
-Attribute VB_Name = "Module2"
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mRead
->>>>>>
-Attribute VB_Name = "mRead"
-
-Option Explicit
-
-
-
-
-Sub ReadData1(aPoint As String, Hist As Integer, dt As Integer, _
-              p As PriceData)
-'������������� ���� PriceData �� ������� ���� - 1
-'k��������� �� ����� ��� hist ��������� �����
-'aPoint - ������ �������
-'������ ��� ������ ������� �������������� ������ (������)
- Dim n As Integer, i As Integer
-'����������� ����� ����� ������� - n
- Dim theRange As Range
- Set theRange = ActiveSheet.Range(aPoint)
- n = 0
- Do While IsEmpty(theRange.Offset(n, 0).Value) = False
-     n = n + 1
- Loop
- If n = 0 Then             '���������� ������ !!!
-    GoTo done
- End If
-' ����� ����� ���������� ()
- If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-    Hist = (n - 3) \ dt + 1 '
- End If
- Dim t As Integer, s As Integer
- For t = 0 To Hist - 1
-      s = n - t * dt - 1
-      p.D(Hist - t) = theRange.Offset(s, 0).Value
-      p.Opn(Hist - t) = theRange.Offset(s, 1).Value
-      p.Hgh(Hist - t) = theRange.Offset(s, 2).Value
-      p.Lw(Hist - t) = theRange.Offset(s, 3).Value
-      p.Cls(Hist - t) = theRange.Offset(s, 4).Value
-'     p.Vl(hist - t) = theRange.Offset(s, 5).Value
- Next t
-done:
-End Sub
-
-
-Function StrNum(aPoint As String)
-' ���������� ����� ����� �������
- Dim theRange As Range
- Set theRange = ActiveSheet.Range(aPoint)
- StrNum = 0
- Do While IsEmpty(theRange.Offset(StrNum, 0).Value) = False
-     StrNum = StrNum + 1
- Loop
-End Function
-
-
-Sub ReadData2(aPoint As String, Hist As Integer, tE As Integer, _
-              p As PriceData)  ' ??? �� �������������
-'������������� ���� PriceData �� ������� ���� - 1
-'k��������� �� ����� ��� hist ��������� �����
-'��������� ������� ��������� ������ � ������� tE
-'aPoint - ������ �������
-'����. ������ ��� ������ ������� �������������� ������ (������)
-'����� ����� �������  ������ ���� ������ tE (!)
- Dim n As Integer, i As Integer
-'1 ����������� ����� ����� ������� - n
- Dim theRange As Range
- Set theRange = ActiveSheet.Range(aPoint)
- If tE - 2 < Hist Then ' ��������� �������
-    Hist = tE - 2
- End If
- Dim t As Integer, s As Integer
- For s = 1 To Hist
-      t = tE - Hist + s - 1
-      p.D(s) = theRange.Offset(t, 0).Value
-      p.Opn(s) = theRange.Offset(t, 1).Value
-      p.Hgh(s) = theRange.Offset(t, 2).Value
-      p.Lw(s) = theRange.Offset(t, 3).Value
-      p.Cls(s) = theRange.Offset(t, 4).Value
-      p.Vl(s) = theRange.Offset(t, 5).Value
- Next s
-done:
-End Sub
-
-
-
-<<<<<<
-======================
-mSignal
->>>>>>
-Attribute VB_Name = "mSignal"
-
-Option Explicit
-'�������� ��� ������ - �������� 1
-Type PriceData
-    D() As String      ' ����������� ����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Integer    ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type Denmark
-   Res() As Double    'Resistance line
-   tRes() As Integer  'Resistance pivot points
-   nRes As Integer    'The number of resistance pivot points
-   AnglRes As Double  'Angle of Declination of Res
-   
-   Supp() As Double       'Support line
-   tSupp() As Integer     'Support pivot points
-   nSupp As Integer       'The number of support pivot points
-   
-   pSig     As Integer    ' parameter for Signal
-   Signal As Integer      'Signal
-   
-   AnglSupp As Double     ' Angle of Declination of Supp
-   Qual(1 To 3) As String ' qualificators
- 
-   nPj As Integer         ' ����� ��������
-   Pj  As Double          ' ��������
-   
-End Type
-
-'*********************
-Dim P_PD As PriceData
-Dim P_DEN As Denmark
-'*********************
-Sub Denmark_Click()    'm
-  Dim nWin As Integer, theList As String, thePoint As String
-  
-  nWin = Range("C3").Value
-  theList = Range("C4").Value
-  thePoint = Range("C5").Value
-  P_DEN.nPj = Range("C6").Value
-  P_DEN.pSig = Range("C7").Value
-' 1. �������
-  Range("F4:H6").ClearContents ' �������-1
-' Range("E9:G9").ClearContents ' �������-2
-' Range("K4:K6").ClearContents ' �������-3
-  Range("B12:G112").Clear         ' ������� - 4
-  Range("H12:I112").ClearContents ' ������� - 4
-' 2. ��������� ������
-  InitPriceData p:=P_PD, tE:=nWin
-  InitDenmark p:=P_DEN, tE:=nWin
-' 3. ������ ������ �� �����
-  Worksheets(theList).Select
-  ReadData1 aPoint:=thePoint, Hist:=P_PD.tC, dt:=1, p:=P_PD
-
-' 5.����������� ��������� P_DEN
-  DetDenmark P_PD, P_DEN
-  If Abs(P_DEN.Signal) > 1 Then  '������� ���������, ���� ���� ������
-      DetProj P_PD, P_DEN
-  End If
-' 6. Output
-  Output_1 "List1", "B11", P_PD, P_DEN
-  Table1 "List1", "F4", P_DEN
-  Table2 "List1", "E9", P_DEN, P_PD
-  Table3 "List1", "k4", P_DEN
-End Sub
-Sub Table1(ListName As String, aPoint As String, pDen As Denmark)
-' Col = 2 - �� ��������� !!!
-  Worksheets(ListName).Select
-  Dim theRange As Range
-  Set theRange = ActiveSheet.Range(aPoint)  '����� ������ ���. ������
-' Status - Col = 0
-  If pDen.nRes >= 2 Then
-     theRange.Offset(0, 0).Value = "O'KEY"
-  Else
-     theRange.Offset(0, 0).Value = "ND!"
-  End If
-  If pDen.nSupp >= 2 Then
-     theRange.Offset(1, 0).Value = "O'KEY"
-  Else
-     theRange.Offset(1, 0).Value = "ND!"
-  End If
-' -----------------------------------------
-' ���� �������� ����� ������������� � ��������� - Col = 1
-  If pDen.nRes >= 2 Then
-    theRange.Offset(0, 1).Value = pDen.AnglRes
-  End If
-  If pDen.nSupp >= 2 Then
-    theRange.Offset(1, 1).Value = pDen.AnglSupp
-  End If
-  If pDen.nRes >= 2 And pDen.nSupp >= 2 Then
-    theRange.Offset(2, 1).Value = (pDen.AnglRes + pDen.AnglSupp) / 2
-  End If
-End Sub
-Sub Table2(ListName As String, aPoint As String, _
-           pDen As Denmark, pPD As PriceData)
-  
-  Worksheets(ListName).Select
-  Dim theRange As Range
-  Set theRange = ActiveSheet.Range(aPoint)  '����� ������ ���. ������
-  If pDen.Signal >= 2 Then
-     MsgBox _
-     "��������! Buy Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & P_DEN.Signal - 1 & " ! "
-     theRange.Offset(0, 0).Value = "Buy"
-     theRange.Offset(0, 1).Value = pPD.D(pPD.tC)
-     theRange.Offset(0, 2).Value = pDen.Signal - 1
-     theRange.Offset(0, 3).Value = pDen.Pj
-  End If
-  If pDen.Signal <= -2 Then
-     MsgBox _
-     "��������! Sell Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(P_DEN.Signal + 1) & "!"
-     theRange.Offset(0, 0).Value = "Sell"
-     theRange.Offset(0, 1).Value = pPD.D(pPD.tC)
-     theRange.Offset(0, 2).Value = pDen.Signal + 1
-     theRange.Offset(0, 3).Value = pDen.Pj
-    End If
-   
-End Sub
-Sub Table3(ListName As String, aPoint As String, pDen As Denmark)
-  Worksheets(ListName).Select
-  Dim theRange As Range
-  Set theRange = ActiveSheet.Range(aPoint)  '����� ������ ���. ������
-  Dim i As Integer
-  For i = 1 To 3
-     theRange.Offset(i - 1, 0).Value = pDen.Qual(i)
-  Next i
-End Sub
-
-
-Sub InitDenmark(p As Denmark, tE As Integer)
-'  ������ ��� Denmark
-   ReDim p.Res(1 To tE)
-   ReDim p.tRes(1 To tE)
-   ReDim p.Supp(1 To tE)
-   ReDim p.tSupp(1 To tE)
-End Sub
-Sub Output_1(ListName As String, aPoint As String, _
-             pPD As PriceData, pDen As Denmark)
-' ����� ������� ������ � ��c��c����� �������� ???
-' �� ������� �������� ListName �� ������ aPoint
-  Worksheets(ListName).Select
-  Dim theRange As Range
-  Set theRange = ActiveSheet.Range(aPoint) '����� ����� ���. ������
-  theRange.Offset(0, 0).Value = "No"
-  theRange.Offset(0, 1).Value = "Date"
-  theRange.Offset(0, 2).Value = "Open"
-  theRange.Offset(0, 3).Value = "High"
-  theRange.Offset(0, 4).Value = "Low"
-  theRange.Offset(0, 5).Value = "Close"
-  theRange.Offset(0, 6).Value = "Res"
-  theRange.Offset(0, 7).Value = "Supp"
-  Dim t As Integer, k As Integer
-  Dim i As Integer, j As Integer
-  i = 1: j = 1
-  For t = 1 To pPD.tC
-      theRange.Offset(t, 0).Value = t
-      theRange.Offset(t, 1).Value = pPD.D(t)
-      theRange.Offset(t, 2).Value = pPD.Opn(t)
-      theRange.Offset(t, 3).Value = pPD.Hgh(t)
-      theRange.Offset(t, 4).Value = pPD.Lw(t)
-      theRange.Offset(t, 5).Value = pPD.Cls(t)
-      If t >= pDen.tRes(1) Then
-        theRange.Offset(t, 6).Value = pDen.Res(t)
-      End If
-     If t >= pDen.tSupp(1) Then
-        theRange.Offset(t, 7).Value = pDen.Supp(t)
-     End If
-     If t = pDen.tRes(i) Then   'temp
-        theRange.Offset(t, 3).Interior.ColorIndex = 4
-        i = i + 1
-     End If
-     If t = pDen.tSupp(j) Then  'temp
-        theRange.Offset(t, 4).Interior.ColorIndex = 8
-        j = j + 1
-     End If
- Next t
-End Sub
-
-'*****************************************
-Sub DetDenmark(pPD As PriceData, pDen As Denmark)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPD  - ����, ����������� ����� ������ �� ����� (����������)
-' ���������:
-' pDen - �������� ������ �������� (������ ��������, pSig - ���������):
-' ����� Res,Supp �� �������, ������� �����, ������� � ������� ��� �������
-' Signal = 0 ������ �����������
-' Signal < 0 ������ ����������� ������ (������ �������)
-' Signal > 0 ������ ����������� ������ (������ �������)
-' ���� pDen.nRes < 2, �� �������� Res �� ������������
-' ���� pDen.nSupp < 2, �� �������� Supp �� ������������
-
-' ��������� ���������
-  Dim i As Integer
-  pDen.Signal = 0
-  For i = 1 To 3
-     pDen.Qual(i) = "-"
-  Next i
-
-' ����������� ����� ��������� � �������������
-  ResLine pPD.Hgh, pPD.tC, pDen.nRes, pDen.Res, pDen.tRes
-  SuppLine pPD.Lw, pPD.tC, pDen.nSupp, pDen.Supp, pDen.tSupp
-  If pDen.nRes >= 2 Then
-       pDen.AnglRes = 57.29578 * _
-       Atn(pDen.Res(pPD.tC) - pDen.Res(pPD.tC - 1))
-  End If
-  If pDen.nSupp >= 2 Then
-       pDen.AnglSupp = 57.29578 * _
-       Atn(pDen.Supp(pPD.tC) - pDen.Supp(pPD.tC - 1))
-  End If
-
-' ������������ ������� ----------------------------------
-  Dim t As Integer
-' 1. ������ ����������� ������: Res ��������� � Res ������ *************
-  If pDen.nRes >= 2 And pDen.AnglRes < 0 Then
-'    ����������� ������� ������� �����
-     If pDen.Res(pPD.tC) < pPD.Cls(pPD.tC) Then
-        pDen.Signal = 1
-        For t = pPD.tC - pDen.pSig To pPD.tC - 1
-           If pPD.Cls(t) > pDen.Res(t) Then
-             pDen.Signal = 0
-             Exit For
-           End If
-        Next t
-     End If
-     If pDen.Signal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-        If pPD.Cls(pPD.tC - 2) > pPD.Cls(pPD.tC - 1) Then
-           pDen.Signal = pDen.Signal + 1
-           pDen.Qual(1) = "*"
-        End If
-'       Qualificator-2: open > Res � ������ �������
-        If pPD.Opn(pPD.tC) > pDen.Res(pPD.tC) Then
-            pDen.Signal = pDen.Signal + 1
-            pDen.Qual(2) = "*"
-        End If
-'       Qualificator-3 - demand value < Res(tC)
-        If 2 * pPD.Cls(pPD.tC - 1) - pPD.Lw(pPD.tC - 1) < pDen.Res(pPD.tC) Then
-           pDen.Signal = pDen.Signal + 1
-           pDen.Qual(3) = "*"
-        End If
-     End If
-  End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: supp ��������� � supp ������
-  If pDen.nSupp >= 2 And pDen.AnglSupp > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-     If pPD.Cls(pPD.tC) < pDen.Supp(pPD.tC) Then
-        pDen.Signal = -1
-        For t = pPD.tC - pDen.pSig To pPD.tC - 1
-           If pPD.Cls(t) < pDen.Supp(t) Then
-             pDen.Signal = 0
-             Exit For
-           End If
-        Next t
-     End If
-     If pDen.Signal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-        If pPD.Cls(pPD.tC - 2) < pPD.Cls(pPD.tC - 1) Then
-           pDen.Signal = pDen.Signal - 1
-           pDen.Qual(1) = "*"
-        End If
-'       Qualificator-2: Open ���� Res � ������ �������
-        If pPD.Opn(pPD.tC) < pDen.Supp(pPD.tC) Then
-           pDen.Signal = pDen.Signal - 1
-           pDen.Qual(2) = "*"
-        End If
-'       Qualificator-3 - supply value(t-1) > Supp(tC)
-        If 2 * pPD.Cls(pPD.tC - 1) - pPD.Hgh(pPD.tC - 1) > pDen.Supp(pPD.tC) Then
-           pDen.Signal = pDen.Signal - 1
-           pDen.Qual(3) = "*"
-        End If
-     End If
-'    ---------------------------------------------
-  End If
-End Sub
-Sub DetProj(pPD As PriceData, pDen As Denmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-Dim pM As Double, t As Integer, tM As Integer, tL As Integer
-
-If pDen.Signal >= 2 Then  ' ������ �������
-
-   tL = pDen.tRes(pDen.nRes)     ' tR determination
-   If tL = pPD.tC Then
-      tL = pDen.tRes(pDen.nRes - 1)
-   End If
-
-'  Projections 1,2 --------------------------------------------
-   If pDen.nPj >= 1 And pDen.nPj <= 2 Then
-'       t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < Res(t)},
-        tM = pPD.tC - 1
-        pM = pPD.Lw(tM) ' L(t-1) < Res(t-1) for t - break point !
-        For t = pPD.tC - 2 To tL Step -1
-          If pPD.Lw(t) < pM And pPD.Lw(t) < pDen.Res(t) Then
-             pM = pPD.Lw(t): tM = t
-          End If
-        Next t
-'       t* is defined
-        If pDen.nPj = 1 Then
- '       P1( tb) = Res(tb) + Res(t*) - L(t*)
-           pDen.Pj = pDen.Res(pPD.tC) + pDen.Res(tM) - pPD.Lw(tM)
-        Else
-           pDen.Pj = pDen.Res(pPD.tC) + pDen.Res(tM) - pPD.Cls(tM)
-        End If
-   End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-   If pDen.nPj = 3 Then
-'      t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < Res(t)}
-       tM = pPD.tC - 1
-       pM = pPD.Cls(tM)
-       For t = pPD.tC - 2 To tL Step -1
-          If pPD.Cls(t) < pM And pPD.Cls(t) < pDen.Res(t) Then
-             pM = pPD.Cls(t): tM = t
-          End If
-       Next t
-'      t* is defined
-       pDen.Pj = pDen.Res(pPD.tC) + pDen.Res(tM) - pPD.Cls(tM)
-   End If
-End If
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-If pDen.Signal <= -2 Then
-   tL = pDen.tSupp(pDen.nSupp)  ' tR determination
-   If tL = pPD.tC Then
-      tL = pDen.tRes(pDen.nSupp - 1)
-   End If
-
-'  Projections 1,2 --------------------------------------------
-   If pDen.nPj = 1 Or pDen.nPj = 2 Then
-'       t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > Supp(t)},
-        tM = pPD.tC - 1
-        pM = pPD.Hgh(tM) ' H(t-1) > Supp(t-1) for t - break point !
-        For t = pPD.tC - 2 To tL Step -1
-          If pPD.Hgh(t) > pM And pPD.Hgh(t) > pDen.Supp(t) Then
-             pM = pPD.Hgh(t): tM = t
-          End If
-        Next t
-'       t* is defined
-        If pDen.nPj = 1 Then
- '         P1( tb) = Supp(tb) + Supp(t*) - H(t*)
-           pDen.Pj = pDen.Supp(pPD.tC) + pDen.Supp(tM) - pPD.Hgh(tM)
-        Else
-'          P2( tb) = Supp(tb) + Supp(t*) - C(t*)
-           pDen.Pj = pDen.Supp(pPD.tC) + pDen.Supp(tM) - pPD.Cls(tM)
-        End If
-   End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-   If pDen.nPj = 3 Then
-'     t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  Supp(t)}
-'     P3( tb) = Supp(tb) + Supp(t*) - C(t*)
-      tM = pPD.tC - 1
-      pM = pPD.Cls(tM)
-      For t = pPD.tC - 2 To tL Step -1
-          If pM < pPD.Cls(t) And pPD.Cls(t) > pDen.Supp(t) Then
-             pM = pPD.Cls(t): tM = t
-          End If
-      Next t
-'      t* is defined
-      pDen.Pj = pDen.Supp(pPD.tC) + pDen.Supp(tM) - pPD.Cls(tM)
-   End If
-End If
-End Sub
-
-Sub ResLine(High() As Double, tE As Integer, nRes As Integer, _
-            Res() As Double, s() As Integer)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ���������:
-' 1) ����� ������������� Res, dom(Res)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(nRes)}, s(1) < s(2) < ...< s(nRes)
-'   ( s(nRes)<= tE )- ������� �����
-' 3) ����� ������� ����� nRes.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� Supp
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
- Dim t As Integer, i As Integer
- Dim v As Double
-'1 ����������� ������� �������� �������
- nRes = 0
- For t = 2 To tE - 1
- '   v = max{high(t-1), high(t+1)} < high(t)
-     v = High(t - 1)
-     If v < High(t + 1) Then
-        v = High(t + 1)
-     End If
-     If High(t) > v Then    'alt.: v >= High(t + 1)
-        s(nRes + 1) = t: nRes = nRes + 1
-     End If
- Next t
- If nRes < 2 Then
-    GoTo done
- End If
-' 2 ����������� ����� �������������
- Res(s(1)) = High(s(1))
- For i = 2 To nRes
-    Res(s(i)) = High(s(i))
-    v = (High(s(i)) - High(s(i - 1))) / (s(i) - s(i - 1))
-    For t = s(i - 1) + 1 To s(i) - 1
-        Res(t) = High(s(i - 1)) + v * (t - s(i - 1))
-    Next t
- Next i
- If s(nRes) < tE Then
-    v = (High(s(nRes)) - High(s(nRes - 1))) / (s(nRes) - s(nRes - 1))
-    For t = s(nRes) + 1 To tE
-        Res(t) = High(s(nRes - 1)) + v * (t - s(nRes - 1))
-    Next t
- End If
-done:
-End Sub
-
-Sub SuppLine(Low() As Double, tE As Integer, nSupp As Integer, _
-               Supp() As Double, s() As Integer)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ���������:
-' 1) ����� ������������� Supp, dom(Supp)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(nSupp)}, s(1) < s(2) < ...< s(nSupp) -
-'    ������� �����
-' 3) ����� ������� ����� nSupp.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
- Dim t As Integer, i As Integer
- Dim v As Double
-'1 ����������� ������� �������� �������
- nSupp = 0
- For t = 2 To tE - 1
-'     v = min{Low(t-1), Low(t+1)} > Low(t)
-      v = Low(t - 1)
-      If v > Low(t + 1) Then
-         v = Low(t + 1)
-      End If
-      If Low(t) < v Then    'alt.: v >= High(t + 1)
-         s(nSupp + 1) = t: nSupp = nSupp + 1
-      End If
- Next t
- If nSupp < 2 Then
-    GoTo done
- End If
-' 2 ����������� ����� ���������
- Supp(s(1)) = Low(s(1))
- For i = 2 To nSupp
-    Supp(s(i)) = Low(s(i))
-    v = (Low(s(i)) - Low(s(i - 1))) / (s(i) - s(i - 1))
-    For t = s(i - 1) + 1 To s(i) - 1
-        Supp(t) = Low(s(i - 1)) + v * (t - s(i - 1))
-    Next t
- Next i
- If s(1) < tE Then
-    v = (Low(s(nSupp)) - Low(s(nSupp - 1))) / (s(nSupp) - s(nSupp - 1))
-    For t = s(nSupp) + 1 To tE
-        Supp(t) = Low(s(nSupp - 1)) + v * (t - s(nSupp - 1))
-    Next t
- End If
-done:
-End Sub
-
-Sub InitPriceData(p As PriceData, tE As Integer)
-' ������������� ������ �� �����
-  p.tC = tE
-  ReDim p.D(1 To tE)
-  ReDim p.Opn(1 To tE)
-  ReDim p.Hgh(1 To tE)
-  ReDim p.Lw(1 To tE)
-  ReDim p.Cls(1 To tE)
-  ReDim p.Vl(1 To tE)
-End Sub
-
-
-
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mTester1
->>>>>>
-Attribute VB_Name = "mTester1"
-Option Explicit
-Dim HISTORY As PriceData
-
-Sub Test1Denmark_Click()
-  
-  Dim nWin As Integer, nHist As Integer, _
-      theList As String, thePoint As String, _
-      Shift As Integer, pDen As Integer, pEMA As Integer
-' ������ ������-------------------------------
-  theList = Range("C4").Value     '������
-  thePoint = Range("C5").Value    '������
-  nHist = Range("C6").Value       '�������
-  nWin = Range("C7").Value        '����
-  pEMA = Range("C8").Value        '������� ��. ���������
-  Shift = Range("C9").Value       '�������� > 0
-  pDen = Range("C10").Value       '�������� Den
-' --------------------------------------------
-  Range("B16:H366").ClearContents
-
-' ����������� ��������� �������
-  InitPriceData p:=HISTORY, tE:=nHist   ' ������ ��� HISTORY
-  Worksheets(theList).Select            ' ����� ����� � �������
-  ReadData1 aPoint:=thePoint, Hist:=HISTORY.tC, dt:=1, p:=HISTORY
-' ���������� �������� ������� ���  HISTORY
-  
-  Worksheets("Testing").Select
-  Dim Win As PriceData, Den As Denmark
-  InitPriceData Win, nWin  ' ������ ��� ����
-  InitDenmark Den, nWin    ' ������ ��� Den ������(Den) = ������(Win)
-  Den.pSig = pDen
-  
-  
-  Dim theRange As Range
-  Set theRange = ActiveSheet.Range("B16")  '����� ������ ���. ������
-  
-  Dim t As Integer, i As Integer
-  Dim Sig As Integer, nSucc As Integer, nFall As Integer, Num As Integer
-  ReDim mov(1 To HISTORY.tC) As Double
-  Num = 0: nSucc = 0: nFall = 0
-  ExpMA1 HISTORY.Cls, 1, HISTORY.tC, 2 / (pEMA + 1), mov ' moving averige
-  
-  For t = Win.tC To HISTORY.tC - Shift   ' nWin  <= t <= P_DEN.tC
-'     ����������� ������� �� ������ t  �� ���� Win
-      Sig = DenSignal(t, Win, HISTORY, Den)
-      If Sig <> 0 Then
-         If Sig * Sign((mov(t + Shift) - mov(t))) >= 0 Then
-               nSucc = nSucc + 1
-         Else
-               nFall = nFall + 1
-         End If
-         Num = Num + 1
-      End If
-      theRange.Offset(t - nWin, 0).Value = t
-      theRange.Offset(t - nWin, 1).Value = HISTORY.D(t)
-      theRange.Offset(t - nWin, 2).Value = HISTORY.Opn(t)
-      theRange.Offset(t - nWin, 3).Value = HISTORY.Hgh(t)
-      theRange.Offset(t - nWin, 4).Value = HISTORY.Lw(t)
-      theRange.Offset(t - nWin, 5).Value = HISTORY.Cls(t)
-      If Sig <> 0 Then
-         theRange.Offset(t - nWin, 6).Value = Sig
-      End If
-  Next t
-  
-  Set theRange = ActiveSheet.Range("F4")  '����� ������ ���. ������
-  theRange.Offset(0, 0).Value = Num
-  theRange.Offset(0, 1).Value = nSucc
-  theRange.Offset(0, 2).Value = nFall
-  theRange.Offset(0, 3).Value = nSucc / Num
-  
-  
-End Sub
-
-Function DenSignal(t As Integer, _
-                   Win As PriceData, _
-                   Hist As PriceData, _
-                   Den As Denmark) As Integer
-                   
-' ������ � ������� ��� ������� �� ��������
-' �������� ������:
-' 1. t - ������ �������, �� ������� ������������ ������
-'    win.tC <= t <= Hist.tC
-' 2. win.tC -������ ���������� ����, �� �������� ������������  ����� ��������
-'    ������ ��� ���� ��������.
-' 3. Hist - �������, �������� ������� ��������� ����������.
-' 4. Den.pSig - �������� �������, ������ ��� Den ��������
-' ���������:
-' DenSignal >= 1 -  ������ � ������� ~ ��������� ���������
-' DenSignal =  0 -  ������� ���
-' DenSignal <= -1 - ������ � ������� ~ ��������� ���������
-' * ���������� �������� DenSignal = ����� ������������� ��������������
-
-' ����������� ����
-  Dim i As Integer
-  For i = 1 To Win.tC
-      Win.D(i) = Hist.D(t - Win.tC + i)
-      Win.Cls(i) = Hist.Cls(t - Win.tC + i)
-      Win.Opn(i) = Hist.Opn(t - Win.tC + i)
-      Win.Hgh(i) = Hist.Hgh(t - Win.tC + i)
-      Win.Lw(i) = Hist.Lw(t - Win.tC + i)
-  Next i
-  DetDenmark Win, Den  '�������� �������� ���������� ��� t
-  If Den.Signal > 1 Then
-     DenSignal = Den.Signal - 1
-  End If
-  If Den.Signal < -1 Then
-     DenSignal = Den.Signal + 1
-  End If
-End Function
-
-Function Sign(x As Double) As Integer
-    Sign = 0
-    If x > 0 Then
-       Sign = 1
-    ElseIf x < 0 Then
-       Sign = -1
-    End If
-End Function
-
-' ���������������� ���������� �������
-Sub ExpMA1(x() As Double, t1 As Integer, t2 As Integer, alfa As Double, _
-           s() As Double)
-    ' x , dom(x) = [t1,t2], - �������� ���
-    ' 0 <= alfa <= 1 - ������� �����������
-    ' alfa = 2/(nWin+1)
-    ' alfa <= 0 --> s = 0; alfa => 1 s = x
-    ' ���������: S , dom(S) = [t1,t2], - ���������� �������
-    Dim S0 As Double, beta As Double
-    Dim k As Integer, t As Integer
-    ' S0 determination
-    If alfa <= 0 Then
-       For t = t1 To t2
-          s(t) = 0
-       Next t
-       GoTo done
-    End If
-    If alfa >= 1 Then
-       For t = t1 To t2
-          s(t) = x(t)
-       Next t
-       GoTo done
-    End If
-    S0 = 0
-    k = 5    ' ������� ����������, k < (t2-t1+1)/2  !!!
-    For t = t1 To t1 + k - 1
-        S0 = S0 + x(t)
-    Next t
-    S0 = S0 / k
-    'main cycle
-    beta = 1 - alfa
-    s(t1) = alfa * x(t1) + beta * S0
-    For t = t1 + 1 To t2
-        s(t) = alfa * x(t) + beta * s(t - 1)
-    Next t
-done:
-End Sub
-
-
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'Denmark_method'
-Quirk - duff tag length======================
-MGetWebData
->>>>>>
-Attribute VB_Name = "MGetWebData"
-Option Explicit
-
-Const QueryDataName As String = "ExternalDenmarkData"
-
-Sub UpdateHistory()
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim denWindow As Integer
-    With ThisWorkbook
-        .Activate
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            denWindow = .Range("DEN_WINDOW") + 2
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table
-            .Range(.Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL), .Cells(65535, RAW_DATA_RANGE_COL + PROJECT_IDX)).ClearContents
-            QryPathStr = GetQryPath
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-    
-    '        .Parent.Application.DisplayAlerts = False
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=False, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-    '        .Parent.Application.DisplayAlerts = True
-            Dim i, j, row_idx As Integer
-            Dim CurrentDate As String
-            Dim RawData As Range
-            Set RawData = .Range(RAW_DATA_RANGE)
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range(.Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX)).ClearContents
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).delete xlShiftUp
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' thisWorkbook
-End Sub
-
-Private Function GetQryPath() As String
-    Dim QryPathStr As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/online/nph-single.cgi?"
-        QryPathStr = QryPathStr & "ticker=" & .Range("DEN_SYMBOL")
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        QryPathStr = QryPathStr & "&period=60&oh=11&ch=18&separator=%2C&vmode=Ignore&vtype=BA2&format=Excel"
-        QryPathStr = QryPathStr & "&daysback=" & .Range("DEN_HISTORY")
-'        .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-    
-End Function
-
-Sub UpdateTickerList()
-    Dim Idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    With ThisWorkbook
-        With .Worksheets(VAR_SHEET)
-            Idx = .Range("IDX_DEN_LIST")
-            Set Location = .Range("TICKER_TABLES").Offset(0, (Idx - 1) * 2)
-             .Range("IDX_DEN_SYMBOL") = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            QryPathStr = GetListPath
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            ' Remove header
-            ' Find [DATA]
-            n = 0
-            Do While Location.Offset(n, 0) <> "[DATA]"
-                n = n + 1
-            Loop
-            .Range(Location.Offset(1, 0), Location.Offset(n, 1)).delete Shift:=xlUp
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-        
-        '        .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 0), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-        ' Setup Ticker List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Address
-         End With
-        .Worksheets(FORM_SHEET) _
-            .Shapes("cbxTikers").ControlFormat.ListFillRange = DestRangeArea
-    End With
-End Sub
-
-Private Function GetListPath() As String
-    Dim QryPathStr As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/~anton/databuilder/secure/names.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        QryPathStr = QryPathStr & "&category=STOCKS"
-        '.Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Application.ScreenUpdating = False
-    If Application.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        Shell "EXCEL " & wbname
-        ThisWorkbook.Close Savechanges:=False
-        Exit Sub
-    End If
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun (ESTIMATION_DATE)
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            ThisWorkbook.Save
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(FORM_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mReadWrie
->>>>>>
-Attribute VB_Name = "mReadWrie"
-Option Explicit
-
-Public Const GOOD_LINE_STATUS As String = "Ok"
-Public Const BAD_LINE_STATUS As String = "N/A"
-
-Function ReadWebData(Location As Range, Hist As Integer, dt As Integer, _
-              pPriceData As TPriceData) As Integer
-    '������������� ���� TPriceData �� ������� ���� - 1
-    'k��������� �� ����� ��� hist ��������� �����
-    'aPoint - ������ �������
-    '������ ��� ������ ������� �������������� ������ (������)
-    Dim n, i As Integer
-    
-    '����������� ����� ����� ������� - n
-    n = GetLinesCount(Location)
-    ReadWebData = n
-    If n < 9 Then             '���������� ������ !!!
-        GoTo done
-    End If
-    ' ����� ����� ���������� ()
-    If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-        Hist = (n - 3) \ dt + 1 '
-    End If
-    Dim t, s As Integer
-    For t = 0 To Hist - 1
-        s = n - t * dt - 1
-        pPriceData.D(Hist - t) = Location.Offset(s, DATE_IDX).Value
-        pPriceData.Tm(Hist - t) = Location.Offset(s, TIME_IDX).Value
-        pPriceData.Opn(Hist - t) = Location.Offset(s, OPEN_IDX).Value
-        pPriceData.Hgh(Hist - t) = Location.Offset(s, HIGH_IDX).Value
-        pPriceData.Lw(Hist - t) = Location.Offset(s, LOW_IDX).Value
-        pPriceData.Cls(Hist - t) = Location.Offset(s, CLOSE_IDX).Value
-        pPriceData.Vl(Hist - t) = Location.Offset(s, VOLUME_IDX).Value
-    Next t
-    ReadWebData = t + 1
-done:
-End Function
-
-Sub ResultLinesOut(Location As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim n As Integer
-    
-    n = GetLinesCount(Location)
-    With Location
-        .Offset(-1, RESIST_IDX) = "Res"
-        .Offset(-1, SUPPORT_IDX) = "Supp"
-        .Offset(-1, PROJECT_IDX) = "Project"
-    End With
-    Dim t, count, Idx, loc_idx As Integer
-    count = pPD.tC
-    For t = 0 To count - 1
-        Idx = count - t
-        loc_idx = n - t - 1
-        If pDen.res(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, RESIST_IDX).Value = pDen.res(Idx)
-        End If
-        If pDen.Supp(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, SUPPORT_IDX).Value = pDen.Supp(Idx)
-        End If
-        If Abs(pDen.Signal) > 1 Then
-            Location.Offset(loc_idx, PROJECT_IDX).Value = pDen.Pj
-        End If
-    Next t
-End Sub
-
-Sub Out_Table_1(TheRange As Range, pDen As TDenmark, LastIdx As Integer)
-    
-    
-    ' Col = 2 - �� ��������� !!!
-    ' Status - Col = 0
-    If pDen.nRes >= 2 Then
-        TheRange.Offset(0, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(0, 0).Value = BAD_LINE_STATUS
-    End If
-    If pDen.nSupp >= 2 Then
-        TheRange.Offset(1, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(1, 0).Value = BAD_LINE_STATUS
-    End If
-    ' -----------------------------------------
-    ' ���� �������� ����� ������������� � ��������� - Col = 1
-    If pDen.nRes >= 2 Then
-        TheRange.Offset(0, 1).Value = pDen.AnglRes
-    End If
-    If pDen.nSupp >= 2 Then
-        TheRange.Offset(1, 1).Value = pDen.AnglSupp
-    End If
-    If pDen.nRes >= 2 And pDen.nSupp >= 2 Then
-        TheRange.Offset(2, 1).Value = (pDen.AnglRes + pDen.AnglSupp) / 2
-    End If
-    ' -----------------------------------------
-    ' ������� ���� ����� �������� �� ������� ������
-    If pDen.nRes >= 2 Then
-        TheRange.Offset(0, 2).Value = pDen.res(LastIdx)
-    End If
-    If pDen.nSupp >= 2 Then
-        TheRange.Offset(1, 2).Value = pDen.Supp(LastIdx)
-    End If
-    If pDen.nRes >= 2 And pDen.nSupp >= 2 Then
-        TheRange.Offset(2, 2).Value = _
-            (pDen.res(LastIdx) + pDen.Supp(LastIdx)) / 2
-    End If
-    
-End Sub
-
-Sub Out_Table_2(TheRange As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim signal_defined, allert_enable  As Boolean
-    Dim Message As String
-    signal_defined = False
-    allert_enable = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_ALLERT_DLG")
-    Message = "������ �� ��������� ������ �� ���������������."
-    If pDen.Signal >= 2 Then
-        signal_defined = True
-        TheRange.Offset(0, 0).Value = "BUY"
-        TheRange.Offset(0, 1).Value = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value = pDen.Signal - 1
-        TheRange.Offset(0, 3).Value = pDen.Pj
-        Message = "BUY Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & pDen.Signal - 1 & " ! "
-    End If
-    If pDen.Signal <= -2 Then
-        signal_defined = True
-        TheRange.Offset(0, 0).Value = "SELL"
-        TheRange.Offset(0, 1).Value = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value = pDen.Signal + 1
-        TheRange.Offset(0, 3).Value = pDen.Pj
-        Message = "SELL Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(pDen.Signal + 1) & "!"
-    End If
-    With ThisWorkbook.Worksheets(FORM_SHEET).Range("TABLE_COMMENT")
-        .Value = Message
-        .Font.Bold = True
-        Dim color_idx As Integer
-        If signal_defined Then
-            If pDen.Signal < 0 Then
-                .Font.ColorIndex = 3
-            Else
-                .Font.ColorIndex = 5
-            End If
-        Else
-            .Font.ColorIndex = 14
-        End If
-    End With
-    If allert_enable And signal_defined Then
-        MsgBox _
-            Prompt:=Message, _
-            Title:=PROGRAM_NAME, _
-            Buttons:=vbOKOnly + vbInformation
-    End If
-End Sub
-
-Sub Out_Table_3(TheRange As Range, pDen As TDenmark)
-    Dim i As Integer
-    For i = 1 To 3
-        TheRange.Offset(i - 1, 0).Value = pDen.Qual(i)
-    Next i
-End Sub
-
-Sub Out_Table_4(TheRange As Range, pPD As TPriceData)
-    Dim LastIdx As Integer
-    LastIdx = pPD.tC
-    With TheRange
-        .Offset(0, 0) = pPD.D(LastIdx)
-        .Offset(0, 1) = pPD.Tm(LastIdx)
-        .Offset(0, 2) = pPD.Opn(LastIdx)
-        .Offset(0, 3) = pPD.Hgh(LastIdx)
-        .Offset(0, 4) = pPD.Lw(LastIdx)
-        .Offset(0, 5) = pPD.Cls(LastIdx)
-        .Offset(0, 6) = pPD.Cls(LastIdx) - pPD.Cls(LastIdx - 1)
-    End With
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Denmark method bar"
-Const common_pwd = "31415926"
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-    End With
-    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(wb As Workbook)
-    With wb
-        .Application.ScreenUpdating = False
-        
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(FORM_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-            .Select
-        End With
-        With .Worksheets(CHART_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-        End With
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(wb As Workbook)
-    With wb
-        .Unprotect
-        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Unprotect
-        End With
-        With .Worksheets(FORM_SHEET)
-            .Select
-            .Unprotect
-        End With
-        .Application.ScreenUpdating = True
-        
-    End With
-End Sub
-
-<<<<<<
-======================
-mTypes
->>>>>>
-Attribute VB_Name = "mTypes"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "����� ��������� ��������"
-Public Const PROGRAM_VERSION As String = "version 1.0"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-Public Const ESTIMATION_DATE As Long = 19980915
-'Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "J27"
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const PRICE_TABLE As String = "A1"
-Public Const RAW_DATA_RANGE As String = "A3"
-Public Const RAW_DATA_RANGE_COL As Integer = 1
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-Public Const VAR_SHEET As String = "Var_s"
-
-Public Const CHART_SHEET As String = "Chart"
-
-Public Const MIN_PRICE_VALUE As Double = 0.000001
-Public Const MAX_PRICE_VALUE As Double = 1000000000
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const CLOSE_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const HIGH_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const RESIST_IDX As Integer = 7
-Public Const SUPPORT_IDX As Integer = 8
-Public Const PROJECT_IDX As Integer = 9
-
-Type TPriceData
-    D() As String      ' ����������� ����
-    Tm() As String     ' �����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Double     ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type TDenmark
-   res() As Double          'Resistance line
-   tRes() As Integer        'Resistance pivot points
-   nRes As Integer          'The number of resistance pivot points
-   AnglRes As Double        'Angle of Declination of Res
-   
-   Supp() As Double         'Support line
-   tSupp() As Integer       'Support pivot points
-   nSupp As Integer         'The number of support pivot points
-   
-   pSig     As Integer      ' parameter for Signal
-   Signal As Integer        'Signal
-   
-   AnglSupp As Double       ' Angle of Declination of Supp
-   Qual(1 To 3) As String   ' qualificators
- 
-   nPj As Integer           ' ����� ��������
-   Pj  As Double            ' �������� ����
-   
-End Type
-
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-Dim AppRunEnable As New cEnableRun
-
-Sub evHistory_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_DATA_READY") = False
-    End With
-End Sub
-
-Sub evSubmit_Click()
-    Dim ticker As String
-    AppRunEnable.EnableRun (ESTIMATION_DATE)
-    Application.Cursor = xlWait
-    With ThisWorkbook
-        With .Worksheets(VAR_SHEET)
-            ticker = .Range("DEN_SYMBOL")
-            If .Range("BOOL_DATA_DOWNLOAD") = True Or .Range("BOOL_DATA_READY") = False Then
-                UpdateHistory
-                .Range("BOOL_DATA_READY") = True
-            End If
-        End With
-        If TDenmark_Calc Then
-            With .Worksheets(FORM_SHEET)
-                .Range("CALC_TICKER_NAME") = ticker
-            End With
-        End If
-    End With
-    Application.Cursor = xlDefault
-    
-End Sub
-
-
-Sub evParamChange()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DENMARK_READY") = False
-End Sub
-
-Sub evGroupChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        GroupIdx = .Range("IDX_DEN_LIST")
-        .Range("IDX_DEN_SYMBOL") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat.ListFillRange = NewCbxRange
-    End With
-    evHistory_Change
-End Sub
-
-Sub evUpdateTickerList()
-    UpdateTickerList
-    evHistory_Change
-End Sub
-
-Sub cmViewChart()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        If .Range("BOOL_DENMARK_READY") <> True Then
-            If .Range("BOOL_AUTORECALC") = True Then
-                evSubmit_Click
-                If .Range("BOOL_DENMARK_READY") <> True Then
-                    Exit Sub
-                End If
-            Else
-                MsgBox _
-                    "������ �� ����� ���� ��������." & vbCrLf & "�������� ������ �� ����������.", _
-                    vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End If
-    End With
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        With .Range("TABLE_1")
-            Dim test_lines As Boolean
-            test_lines = StrComp(.Cells(1, 1).Value, GOOD_LINE_STATUS)
-            test_lines = test_lines + StrComp(.Cells(2, 1).Value, GOOD_LINE_STATUS)
-            If test_lines <> 0 Then
-                MsgBox _
-                    Prompt:="������ �� ����� ���� ��������." & vbCrLf & "������� ����� �� ���������� .", _
-                    Title:=PROGRAM_NAME, _
-                    Buttons:=vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End With
-        Draw_Chart Not IsEmpty(.Range("TABLE_2").Cells(1, 1))
-    End With
-    With ThisWorkbook
-        .Worksheets(CHART_SHEET).Select
-    End With
-End Sub
-
-Sub cmViewForm()
-    With ThisWorkbook
-        .Worksheets(FORM_SHEET).Select
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Dim res
-    res = MsgBox( _
-        Prompt:="�� ������� ��������� ���������?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If res = vbYes Then
-       Application.Quit
-    End If
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\help\Denmark.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable wb:=ThisWorkbook
-    SetEnvironment wb:=ThisWorkbook
-    ProtectionEnable wb:=ThisWorkbook
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-End Sub
-
-Sub cmSetDesignerMode()
-    Const right_pwd As Long = 31415926
-    Dim rp As String
-    rp = right_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable wb:=ThisWorkbook
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=True
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-<<<<<<
-======================
-mDenmark
->>>>>>
-Attribute VB_Name = "mDenmark"
-Option Explicit
-
-Public Const FORM_SHEET As String = "MainForm"
-
-'Form Ranges
-Public Const TABLE_1 As String = "TABLE_1"
-Public Const TABLE_2 As String = "TABLE_2"
-Public Const TABLE_3 As String = "TABLE_3"
-Public Const TABLE_4 As String = "TABLE_4"
-Public Const TABLE_COMMENT As String = "TABLE_COMMENT"
-
-'�������� ��� ������ - �������� 1
-
-'*********************
-Dim PriceDataArray As TPriceData
-Dim DenmarkDataArray As TDenmark
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Function TDenmark_Calc() As Boolean
-    
-    Dim nWindow As Integer
-    
-    mobjAppRunEnable.EnableRun (ESTIMATION_DATE)
-    
-    With ThisWorkbook
-        .Activate
-'1)    Read User data
-        With .Worksheets(VAR_SHEET)
-            DenmarkDataArray.nPj = .Range("DEN_PROECT").Value
-            DenmarkDataArray.pSig = .Range("DEN_PARAM").Value
-            nWindow = .Range("DEN_WINDOW").Value
-        End With
-
-'2)   Memory allocation
-        allocate_memory PriceDataArray, DenmarkDataArray, nWindow
-
-'3)   Read data
-        Dim TheRange As Range
-        Set TheRange = .Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE)
-        Dim LinesCount As Integer
-        LinesCount = ReadWebData(Location:=TheRange, Hist:=PriceDataArray.tC, dt:=1, pPriceData:=PriceDataArray)
-        
-        'Init function result
-        TDenmark_Calc = LinesCount >= nWindow
-        
-        If LinesCount >= nWindow Then
-        
-'4)   Calculate metod TDenmarkDataArray
-            DetDenmark PriceDataArray, DenmarkDataArray
-            If Abs(DenmarkDataArray.Signal) > 1 Then  '������� ���������, ���� ���� ������
-                DetProj PriceDataArray, DenmarkDataArray
-            End If
-'5)   Write result
-            Application.ScreenUpdating = False
-    
-'6)    Clear interface tables
-            With .Worksheets(FORM_SHEET)
-                .Range(TABLE_1).ClearContents ' �������-1
-                .Range(TABLE_2).ClearContents ' �������-2
-                .Range(TABLE_3).ClearContents ' �������-3
-                .Range(TABLE_COMMENT).Value = "" ' ����������-3
-                .Range(TABLE_4).ClearContents ' �������-4
-            End With
-    
-            ResultLinesOut Location:=TheRange.Offset(2, 0), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-            With .Worksheets(FORM_SHEET)
-                Out_Table_1 TheRange:=.Range(TABLE_1).Cells(1, 1), pDen:=DenmarkDataArray, LastIdx:=PriceDataArray.tC
-                Out_Table_2 TheRange:=.Range(TABLE_2).Cells(1, 1), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-                Out_Table_3 TheRange:=.Range(TABLE_3).Cells(1, 1), pDen:=DenmarkDataArray
-                Out_Table_4 TheRange:=.Range(TABLE_4).Cells(1, 1), pPD:=PriceDataArray
-            End With
-            .Worksheets(VAR_SHEET).Range("BOOL_DENMARK_READY") = True
-        Else
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            .Worksheets(VAR_SHEET).Range("BOOL_DENMARK_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-'7)   Free unused memory
-        free_unused_memory PriceDataArray, DenmarkDataArray
-    End With
-    
-End Function
-
-Sub allocate_memory(pPriceData As TPriceData, pDenmarkData As TDenmark, memsize As Integer)
-'  ������ ��� TDenmark
-    ReDim pDenmarkData.res(1 To memsize)
-    ReDim pDenmarkData.tRes(1 To memsize)
-    ReDim pDenmarkData.Supp(1 To memsize)
-    ReDim pDenmarkData.tSupp(1 To memsize)
-   
-' ������������� ������ �� �����
-    pPriceData.tC = memsize
-    ReDim pPriceData.D(1 To memsize)
-    ReDim pPriceData.Tm(1 To memsize)
-    ReDim pPriceData.Opn(1 To memsize)
-    ReDim pPriceData.Hgh(1 To memsize)
-    ReDim pPriceData.Lw(1 To memsize)
-    ReDim pPriceData.Cls(1 To memsize)
-    ReDim pPriceData.Vl(1 To memsize)
-
-End Sub
-
-Sub free_unused_memory(pP As TPriceData, pD As TDenmark)
-'   Free Prices
-    pP.tC = 0
-    Erase pP.D
-    Erase pP.Tm
-    Erase pP.Opn
-    Erase pP.Hgh
-    Erase pP.Lw
-    Erase pP.Cls
-    Erase pP.Vl
-    
-'Free TDenmark
-    Erase pD.res
-    Erase pD.tRes
-    Erase pD.Supp
-    Erase pD.tSupp
-End Sub
-
-
-'*****************************************
-Sub DetDenmark(pPriceData As TPriceData, pDenmarkData As TDenmark)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPriceData  - ����, ����������� ����� ������ �� ����� (����������)
-' ���������:
-' pDenmarkData - �������� ������ �������� (������ ��������, pSig - ���������):
-' ����� Res,Supp �� �������, ������� �����, ������� � ������� ��� �������
-' Signal = 0 ������ �����������
-' Signal < 0 ������ ����������� ������ (������ �������)
-' Signal > 0 ������ ����������� ������ (������ �������)
-' ���� pDenmarkData.nRes < 2, �� �������� Res �� ������������
-' ���� pDenmarkData.nSupp < 2, �� �������� Supp �� ������������
-
-' ��������� ���������
-    Const QUALIFICATOR_DISABLE As String = "-"
-    Const QUALIFICATOR_ENABLE As String = "Signal"
-    
-    Dim i As Integer
-    pDenmarkData.Signal = 0
-    For i = 1 To 3
-        pDenmarkData.Qual(i) = QUALIFICATOR_DISABLE
-    Next i
-    
-' ����������� ����� ��������� � �������������
-    ResLine pPriceData.Hgh, pPriceData.tC, pDenmarkData.nRes, pDenmarkData.res, pDenmarkData.tRes
-    SuppLine pPriceData.Lw, pPriceData.tC, pDenmarkData.nSupp, pDenmarkData.Supp, pDenmarkData.tSupp
-    If pDenmarkData.nRes >= 2 Then
-        pDenmarkData.AnglRes = 57.29578 * _
-            Atn(pDenmarkData.res(pPriceData.tC) - _
-                pDenmarkData.res(pPriceData.tC - 1))
-    End If
-    If pDenmarkData.nSupp >= 2 Then
-        pDenmarkData.AnglSupp = 57.29578 * _
-            Atn(pDenmarkData.Supp(pPriceData.tC) - _
-                pDenmarkData.Supp(pPriceData.tC - 1))
-    End If
-
-' ������������ ������� ----------------------------------
-    Dim t As Integer
-' 1. ������ ����������� ������: Res ��������� � Res ������ *************
-    If pDenmarkData.nRes >= 2 And pDenmarkData.AnglRes < 0 Then
-'    ����������� ������� ������� �����
-        If pDenmarkData.res(pPriceData.tC) < pPriceData.Cls(pPriceData.tC) Then
-            pDenmarkData.Signal = 1
-            For t = pPriceData.tC - pDenmarkData.pSig To pPriceData.tC - 1
-                If pPriceData.Cls(t) > pDenmarkData.res(t) Then
-                    pDenmarkData.Signal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If pDenmarkData.Signal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) > pPriceData.Cls(pPriceData.tC - 1) Then
-                pDenmarkData.Signal = pDenmarkData.Signal + 1
-                pDenmarkData.Qual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: open > Res � ������ �������
-            If pPriceData.Opn(pPriceData.tC) > pDenmarkData.res(pPriceData.tC) Then
-                pDenmarkData.Signal = pDenmarkData.Signal + 1
-                pDenmarkData.Qual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - demand value < Res(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Lw(pPriceData.tC - 1) < pDenmarkData.res(pPriceData.tC) Then
-                pDenmarkData.Signal = pDenmarkData.Signal + 1
-                pDenmarkData.Qual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-    End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: supp ��������� � supp ������
-    If pDenmarkData.nSupp >= 2 And pDenmarkData.AnglSupp > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-        If pPriceData.Cls(pPriceData.tC) < pDenmarkData.Supp(pPriceData.tC) Then
-            pDenmarkData.Signal = -1
-            For t = pPriceData.tC - pDenmarkData.pSig To pPriceData.tC - 1
-                If pPriceData.Cls(t) < pDenmarkData.Supp(t) Then
-                    pDenmarkData.Signal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If pDenmarkData.Signal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) < pPriceData.Cls(pPriceData.tC - 1) Then
-                pDenmarkData.Signal = pDenmarkData.Signal - 1
-                pDenmarkData.Qual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: Open ���� Res � ������ �������
-            If pPriceData.Opn(pPriceData.tC) < pDenmarkData.Supp(pPriceData.tC) Then
-                pDenmarkData.Signal = pDenmarkData.Signal - 1
-                pDenmarkData.Qual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - supply value(t-1) > Supp(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Hgh(pPriceData.tC - 1) > pDenmarkData.Supp(pPriceData.tC) Then
-                pDenmarkData.Signal = pDenmarkData.Signal - 1
-                pDenmarkData.Qual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-'    ---------------------------------------------
-    End If
-End Sub
-
-Sub DetProj(pPriceData As TPriceData, pDenmarkData As TDenmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-    Dim pM As Double, t As Integer, Tm As Integer, tL As Integer
-
-    If pDenmarkData.Signal >= 2 Then  ' ������ �������
-
-        tL = pDenmarkData.tRes(pDenmarkData.nRes)     ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.tRes(pDenmarkData.nRes - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.nPj >= 1 And pDenmarkData.nPj <= 2 Then
-'           t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < Res(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Lw(Tm) ' L(t-1) < Res(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Lw(t) < pM And pPriceData.Lw(t) < pDenmarkData.res(t) Then
-                    pM = pPriceData.Lw(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.nPj = 1 Then
-'               P1( tb) = Res(tb) + Res(t*) - L(t*)
-                pDenmarkData.Pj = pDenmarkData.res(pPriceData.tC) + pDenmarkData.res(Tm) - pPriceData.Lw(Tm)
-            Else
-                pDenmarkData.Pj = pDenmarkData.res(pPriceData.tC) + pDenmarkData.res(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If ' pDenmarkData.nPj >= 1 And pDenmarkData.nPj <= 2
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.nPj = 3 Then
-'           t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < Res(t)}
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Cls(t) < pM And pPriceData.Cls(t) < pDenmarkData.res(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.Pj = pDenmarkData.res(pPriceData.tC) + pDenmarkData.res(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.Signal >= 2
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-    If pDenmarkData.Signal <= -2 Then
-        tL = pDenmarkData.tSupp(pDenmarkData.nSupp)  ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.tRes(pDenmarkData.nSupp - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.nPj = 1 Or pDenmarkData.nPj = 2 Then
-'           t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > Supp(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Hgh(Tm) ' H(t-1) > Supp(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Hgh(t) > pM And pPriceData.Hgh(t) > pDenmarkData.Supp(t) Then
-                    pM = pPriceData.Hgh(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.nPj = 1 Then
- '              P1( tb) = Supp(tb) + Supp(t*) - H(t*)
-                pDenmarkData.Pj = pDenmarkData.Supp(pPriceData.tC) + pDenmarkData.Supp(Tm) - pPriceData.Hgh(Tm)
-            Else
-'               P2( tb) = Supp(tb) + Supp(t*) - C(t*)
-                pDenmarkData.Pj = pDenmarkData.Supp(pPriceData.tC) + pDenmarkData.Supp(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.nPj = 3 Then
-'           t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  Supp(t)}
-'           P3( tb) = Supp(tb) + Supp(t*) - C(t*)
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pM < pPriceData.Cls(t) And pPriceData.Cls(t) > pDenmarkData.Supp(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.Pj = pDenmarkData.Supp(pPriceData.tC) + pDenmarkData.Supp(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.Signal <= -2
-End Sub
-
-Sub ResLine(High() As Double, tE As Integer, nRes As Integer, _
-            res() As Double, s() As Integer)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ���������:
-' 1) ����� ������������� Res, dom(Res)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(nRes)}, s(1) < s(2) < ...< s(nRes)
-'   ( s(nRes)<= tE )- ������� �����
-' 3) ����� ������� ����� nRes.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� Supp
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
-    Dim t As Integer, i As Integer
-    Dim v As Double
-'1 ����������� ������� �������� �������
-    nRes = 0
-    For t = 2 To tE - 1
- '      v = max{high(t-1), high(t+1)} < high(t)
-        v = High(t - 1)
-        If v < High(t + 1) Then
-            v = High(t + 1)
-        End If
-        If High(t) > v Then    'alt.: v >= High(t + 1)
-            s(nRes + 1) = t: nRes = nRes + 1
-        End If
-    Next t
-    If nRes < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� �������������
-    res(s(1)) = High(s(1))
-    For i = 2 To nRes
-        res(s(i)) = High(s(i))
-        v = (High(s(i)) - High(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            res(t) = High(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(nRes) < tE Then
-        v = (High(s(nRes)) - High(s(nRes - 1))) / (s(nRes) - s(nRes - 1))
-        For t = s(nRes) + 1 To tE
-            res(t) = High(s(nRes - 1)) + v * (t - s(nRes - 1))
-        Next t
-    End If
-done:
-End Sub
-
-Sub SuppLine(Low() As Double, tE As Integer, nSupp As Integer, _
-               Supp() As Double, s() As Integer)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ���������:
-' 1) ����� ������������� Supp, dom(Supp)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(nSupp)}, s(1) < s(2) < ...< s(nSupp) -
-'    ������� �����
-' 3) ����� ������� ����� nSupp.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
-    Dim t As Integer, i As Integer
-    Dim v As Double
-'1 ����������� ������� �������� �������
-     nSupp = 0
-    For t = 2 To tE - 1
-'       v = min{Low(t-1), Low(t+1)} > Low(t)
-        v = Low(t - 1)
-        If v > Low(t + 1) Then
-            v = Low(t + 1)
-        End If
-        If Low(t) < v Then    'alt.: v >= High(t + 1)
-            s(nSupp + 1) = t: nSupp = nSupp + 1
-        End If
-    Next t
-    If nSupp < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� ���������
-    Supp(s(1)) = Low(s(1))
-    For i = 2 To nSupp
-        Supp(s(i)) = Low(s(i))
-        v = (Low(s(i)) - Low(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            Supp(t) = Low(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(1) < tE Then
-        v = (Low(s(nSupp)) - Low(s(nSupp - 1))) / (s(nSupp) - s(nSupp - 1))
-        For t = s(nSupp) + 1 To tE
-            Supp(t) = Low(s(nSupp - 1)) + v * (t - s(nSupp - 1))
-        Next t
-    End If
-done:
-End Sub
-
-<<<<<<
-======================
-mChart
->>>>>>
-Attribute VB_Name = "mChart"
-Option Explicit
-
-Const CHART_NAME As String = "PriceChart"
-
-Sub Draw_Chart(SignalDefined As Boolean)
-
-    Dim n As Integer
-    Dim theChart As Chart
-    Dim ChartDataAria, szLastNumber As String
-    Dim MinYScale As Double
-    
-    With ThisWorkbook
-' Disable screen out
-        .Application.Cursor = xlWait
-        .Application.ScreenUpdating = False
-' Create series range
-        n = GetLinesCount(Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE))
-        szLastNumber = n + 1
-        If SignalDefined Then
-            ChartDataAria = "A2:A" + szLastNumber + ",C2:D" + szLastNumber + ",H2:J" + szLastNumber
-        Else
-            ChartDataAria = "A2:A" + szLastNumber + ",C2:D" + szLastNumber + ",H2:I" + szLastNumber
-        End If
-        MinYScale = GetMinValue(.Worksheets(RAW_DATA_SHEET).Range(ChartDataAria))
-' Find and delete old chart
-        .Worksheets(CHART_SHEET).Unprotect
-        Dim WindowWidth, WindowHeight As Integer
-        With .Worksheets(CHART_SHEET)
-            WindowWidth = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            WindowHeight = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-        With .Worksheets(CHART_SHEET).ChartObjects
-            .delete
-            With .Add(5, 5, WindowWidth - 10, WindowHeight - 10)
-                .SendToBack
-                Set theChart = .Chart
-            End With
-' Create a chart
-        End With
-        With theChart
-            .ChartType = xlLine
-            .SetSourceData Source:=Sheets(RAW_DATA_SHEET).Range( _
-                    ChartDataAria), PlotBy:=xlColumns
-            .Location Where:=xlLocationAsObject, Name:=CHART_SHEET
-            .HasTitle = True
-            With .ChartTitle
-                .Text = ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE).Value
-                With .Font
-                    .Size = 8
-                    .Bold = True
-                End With
-            End With
-            .HasLegend = True
-            With .Legend
-                .Position = xlTop
-                With .Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            .HasDataTable = False
-            With .Axes(xlCategory)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                .TickLabels.Orientation = xlUpward
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .CrossesAt = 1
-                .TickLabelSpacing = 1
-                .TickMarkSpacing = 1
-                .AxisBetweenCategories = False
-                .ReversePlotOrder = False
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            With .Axes(xlValue)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .MinimumScale = MinYScale
-                .MaximumScaleIsAuto = True
-                .MinorUnitIsAuto = True
-                .MajorUnitIsAuto = True
-                .Crosses = xlCustom
-                .CrossesAt = MinYScale
-                .ReversePlotOrder = False
-                .ScaleType = xlLinear
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            .ChartTitle.Top = 5
-            .ChartTitle.Left = 5
-            With .Legend
-                .Top = 5
-                .Fill.OneColorGradient _
-                    Style:=msoGradientHorizontal, _
-                    Variant:=3, _
-                    Degree:=0.303913939116503
-                .Fill.Visible = True
-                .Fill.ForeColor.SchemeColor = 71
-            End With
-            .PlotArea.Left = 10
-            .PlotArea.Top = .Legend.Top + .Legend.Height + 5
-            .PlotArea.Width = .ChartArea.Width - 20
-            .PlotArea.Height = .ChartArea.Height - .PlotArea.Top
-            
-' Tune OPEN line
-            With .SeriesCollection(1)
-                .Border.LineStyle = xlNone
-                .MarkerBackgroundColorIndex = xlNone
-                .MarkerForegroundColorIndex = 1
-                .MarkerStyle = xlPlus
-                .Smooth = False
-                .MarkerSize = 9
-                .Shadow = False
-            End With
-' Tune CLOSE line
-            With .SeriesCollection(2)
-                .Border.ColorIndex = 10
-                .Border.Weight = xlMedium
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune RESISTANCE line
-            With .SeriesCollection(3)
-                .Border.ColorIndex = 3
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune SUUPORT line
-            With .SeriesCollection(4)
-                .Border.ColorIndex = 25
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-            If SignalDefined Then
-                With .SeriesCollection(5)
-                    .Border.ColorIndex = 6
-                    .Border.Weight = xlThin
-                    .Border.LineStyle = xlDot
-                End With
-            End If
-        End With
-        .Application.Cursor = xlDefault
-        With .Worksheets(CHART_SHEET)
-            .Range("A1").Select
-            .Protect userInterfaceOnly:=True
-        End With
-    End With
-End Sub
-
-Function GetMinValue(DataRange As Range) As Double
-    Dim Cell As Range
-    Dim MinValue, MaxValue, RangeValue, CorrectValue, Mult As Double
-    MinValue = MAX_PRICE_VALUE
-    MaxValue = MIN_PRICE_VALUE
-    For Each Cell In DataRange
-        If Not IsEmpty(Cell) And IsNumeric(Cell) Then
-            If Cell > MIN_PRICE_VALUE Then
-                If Cell < MinValue Then
-                    MinValue = Cell
-                End If
-                If Cell > MaxValue Then
-                    MaxValue = Cell
-                End If
-            End If
-        End If
-    Next
-    RangeValue = MaxValue - MinValue
-    If RangeValue < 0 Then
-        MinValue = 0
-    Else
-        CorrectValue = RangeValue / 4
-        Mult = MIN_PRICE_VALUE
-        While MinValue - Int(MinValue * Mult) / Mult > CorrectValue
-            Mult = Mult * 10
-        Wend
-        MinValue = Int(MinValue * Mult) / Mult
-    End If
-    GetMinValue = MinValue
-End Function
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{04E12C90-FC33-11D3-B015-0050048697AF}{04E12C80-FC33-11D3-B015-0050048697AF}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mWebQeury
->>>>>>
-Attribute VB_Name = "mWebQeury"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .Name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.Name = QryName Then
-            WebQuery.delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.Name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-Attribute CreateCommandBar.VB_ProcData.VB_Invoke_Func = "R\n14"
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Contents"
-                        .OnAction = "cmHelpContents"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long)
-    If end_date = NO_ESTIMATION_DATE Then
-        Beep
-        Exit Sub
-    End If
-    Dim TheDate As Date ' Declare variables.
-    TheDate = Now
-    Dim day, month, year As Long
-    Dim curdate As Long
-    day = DatePart("d", TheDate)
-    month = DatePart("m", TheDate)
-    year = DatePart("yyyy", TheDate)
-    curdate = year * 10000
-    curdate = curdate + month * 100
-    curdate = curdate + day
-    If curdate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mTool
->>>>>>
-Attribute VB_Name = "mTool"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub tool_delete_all_tables()
-    QryDelete ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range("A1")
-End Sub
-
-Sub tool_delete_all_charts()
-    Dim theChart As Chart
-    For Each theChart In ThisWorkbook.Charts
-        theChart.delete
-    Next
-End Sub
-
-
-
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{04E12C94-FC33-11D3-B015-0050048697AF}{04E12C88-FC33-11D3-B015-0050048697AF}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-
-
-Private Sub App_WorkbookOpen(ByVal wb As Workbook)
-    Dim wbname As String
-    If Application.Workbooks.count > 1 Then
-        wbname = wb.FullName
-        wb.Close Savechanges:=False
-        Shell "EXCEL " & wbname
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mRead
->>>>>>
-Attribute VB_Name = "mRead"
-
-Option Explicit
-
-
-
-
-Sub ReadData1(aPoint As String, Hist As Integer, dt As Integer, _
-              p As PriceData)
-'������������� ���� PriceData �� ������� ���� - 1
-'k��������� �� ����� ��� hist ��������� �����
-'aPoint - ������ �������
-'������ ��� ������ ������� �������������� ������ (������)
- Dim n As Integer, i As Integer
-'����������� ����� ����� ������� - n
- Dim theRange As Range
- Set theRange = ActiveSheet.Range(aPoint)
- n = 0
- Do While IsEmpty(theRange.Offset(n, 0).Value) = False
-     n = n + 1
- Loop
- If n = 0 Then             '���������� ������ !!!
-    GoTo done
- End If
-' ����� ����� ���������� ()
- If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-    Hist = (n - 3) \ dt + 1 '
- End If
- Dim t As Integer, s As Integer
- For t = 0 To Hist - 1
-      s = n - t * dt - 1
-      p.D(Hist - t) = theRange.Offset(s, 0).Value
-      p.Opn(Hist - t) = theRange.Offset(s, 1).Value
-      p.Hgh(Hist - t) = theRange.Offset(s, 2).Value
-      p.Lw(Hist - t) = theRange.Offset(s, 3).Value
-      p.Cls(Hist - t) = theRange.Offset(s, 4).Value
-'     p.Vl(hist - t) = theRange.Offset(s, 5).Value
- Next t
-done:
-End Sub
-
-
-Function StrNum(aPoint As String)
-' ���������� ����� ����� �������
- Dim theRange As Range
- Set theRange = ActiveSheet.Range(aPoint)
- StrNum = 0
- Do While IsEmpty(theRange.Offset(StrNum, 0).Value) = False
-     StrNum = StrNum + 1
- Loop
-End Function
-
-
-Sub ReadData2(aPoint As String, Hist As Integer, tE As Integer, _
-              p As PriceData)  ' ??? �� �������������
-'������������� ���� PriceData �� ������� ���� - 1
-'k��������� �� ����� ��� hist ��������� �����
-'��������� ������� ��������� ������ � ������� tE
-'aPoint - ������ �������
-'����. ������ ��� ������ ������� �������������� ������ (������)
-'����� ����� �������  ������ ���� ������ tE (!)
- Dim n As Integer, i As Integer
-'1 ����������� ����� ����� ������� - n
- Dim theRange As Range
- Set theRange = ActiveSheet.Range(aPoint)
- If tE - 2 < Hist Then ' ��������� �������
-    Hist = tE - 2
- End If
- Dim t As Integer, s As Integer
- For s = 1 To Hist
-      t = tE - Hist + s - 1
-      p.D(s) = theRange.Offset(t, 0).Value
-      p.Opn(s) = theRange.Offset(t, 1).Value
-      p.Hgh(s) = theRange.Offset(t, 2).Value
-      p.Lw(s) = theRange.Offset(t, 3).Value
-      p.Cls(s) = theRange.Offset(t, 4).Value
-      p.Vl(s) = theRange.Offset(t, 5).Value
- Next s
-done:
-End Sub
-
-
-
-<<<<<<
-======================
-mSignal
->>>>>>
-Attribute VB_Name = "mSignal"
-
-Option Explicit
-'�������� ��� ������ - �������� 1
-Type PriceData
-    D() As String      ' ����������� ����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Integer    ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type Denmark
-   Res() As Double    'Resistance line
-   tRes() As Integer  'Resistance pivot points
-   nRes As Integer    'The number of resistance pivot points
-   AnglRes As Double  'Angle of Declination of Res
-   
-   Supp() As Double       'Support line
-   tSupp() As Integer     'Support pivot points
-   nSupp As Integer       'The number of support pivot points
-   
-   pSig     As Integer    ' parameter for Signal
-   Signal As Integer      'Signal
-   
-   AnglSupp As Double     ' Angle of Declination of Supp
-   Qual(1 To 3) As String ' qualificators
- 
-   nPj As Integer         ' ����� ��������
-   Pj  As Double          ' ��������
-   
-End Type
-
-'*********************
-Dim P_PD As PriceData
-Dim P_DEN As Denmark
-'*********************
-Sub Denmark_Click()    'm
-  Dim nWin As Integer, theList As String, thePoint As String
-  
-  nWin = Range("C3").Value
-  theList = Range("C4").Value
-  thePoint = Range("C5").Value
-  P_DEN.nPj = Range("C6").Value
-  P_DEN.pSig = Range("C7").Value
-' 1. �������
-  Range("F4:H6").ClearContents ' �������-1
-' Range("E9:G9").ClearContents ' �������-2
-' Range("K4:K6").ClearContents ' �������-3
-  Range("B12:G112").Clear         ' ������� - 4
-  Range("H12:I112").ClearContents ' ������� - 4
-' 2. ��������� ������
-  InitPriceData p:=P_PD, tE:=nWin
-  InitDenmark p:=P_DEN, tE:=nWin
-' 3. ������ ������ �� �����
-  Worksheets(theList).Select
-  ReadData1 aPoint:=thePoint, Hist:=P_PD.tC, dt:=1, p:=P_PD
-
-' 5.����������� ��������� P_DEN
-  DetDenmark P_PD, P_DEN
-  If Abs(P_DEN.Signal) > 1 Then  '������� ���������, ���� ���� ������
-      DetProj P_PD, P_DEN
-  End If
-' 6. Output
-  Output_1 "List1", "B11", P_PD, P_DEN
-  Table1 "List1", "F4", P_DEN
-  Table2 "List1", "E9", P_DEN, P_PD
-  Table3 "List1", "k4", P_DEN
-End Sub
-Sub Table1(ListName As String, aPoint As String, pDen As Denmark)
-' Col = 2 - �� ��������� !!!
-  Worksheets(ListName).Select
-  Dim theRange As Range
-  Set theRange = ActiveSheet.Range(aPoint)  '����� ������ ���. ������
-' Status - Col = 0
-  If pDen.nRes >= 2 Then
-     theRange.Offset(0, 0).Value = "O'KEY"
-  Else
-     theRange.Offset(0, 0).Value = "ND!"
-  End If
-  If pDen.nSupp >= 2 Then
-     theRange.Offset(1, 0).Value = "O'KEY"
-  Else
-     theRange.Offset(1, 0).Value = "ND!"
-  End If
-' -----------------------------------------
-' ���� �������� ����� ������������� � ��������� - Col = 1
-  If pDen.nRes >= 2 Then
-    theRange.Offset(0, 1).Value = pDen.AnglRes
-  End If
-  If pDen.nSupp >= 2 Then
-    theRange.Offset(1, 1).Value = pDen.AnglSupp
-  End If
-  If pDen.nRes >= 2 And pDen.nSupp >= 2 Then
-    theRange.Offset(2, 1).Value = (pDen.AnglRes + pDen.AnglSupp) / 2
-  End If
-End Sub
-Sub Table2(ListName As String, aPoint As String, _
-           pDen As Denmark, pPD As PriceData)
-  
-  Worksheets(ListName).Select
-  Dim theRange As Range
-  Set theRange = ActiveSheet.Range(aPoint)  '����� ������ ���. ������
-  If pDen.Signal >= 2 Then
-     MsgBox _
-     "��������! Buy Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & P_DEN.Signal - 1 & " ! "
-     theRange.Offset(0, 0).Value = "Buy"
-     theRange.Offset(0, 1).Value = pPD.D(pPD.tC)
-     theRange.Offset(0, 2).Value = pDen.Signal - 1
-     theRange.Offset(0, 3).Value = pDen.Pj
-  End If
-  If pDen.Signal <= -2 Then
-     MsgBox _
-     "��������! Sell Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(P_DEN.Signal + 1) & "!"
-     theRange.Offset(0, 0).Value = "Sell"
-     theRange.Offset(0, 1).Value = pPD.D(pPD.tC)
-     theRange.Offset(0, 2).Value = pDen.Signal + 1
-     theRange.Offset(0, 3).Value = pDen.Pj
-    End If
-   
-End Sub
-Sub Table3(ListName As String, aPoint As String, pDen As Denmark)
-  Worksheets(ListName).Select
-  Dim theRange As Range
-  Set theRange = ActiveSheet.Range(aPoint)  '����� ������ ���. ������
-  Dim i As Integer
-  For i = 1 To 3
-     theRange.Offset(i - 1, 0).Value = pDen.Qual(i)
-  Next i
-End Sub
-
-
-Sub InitDenmark(p As Denmark, tE As Integer)
-'  ������ ��� Denmark
-   ReDim p.Res(1 To tE)
-   ReDim p.tRes(1 To tE)
-   ReDim p.Supp(1 To tE)
-   ReDim p.tSupp(1 To tE)
-End Sub
-Sub Output_1(ListName As String, aPoint As String, _
-             pPD As PriceData, pDen As Denmark)
-' ����� ������� ������ � ��c��c����� �������� ???
-' �� ������� �������� ListName �� ������ aPoint
-  Worksheets(ListName).Select
-  Dim theRange As Range
-  Set theRange = ActiveSheet.Range(aPoint) '����� ����� ���. ������
-  theRange.Offset(0, 0).Value = "No"
-  theRange.Offset(0, 1).Value = "Date"
-  theRange.Offset(0, 2).Value = "Open"
-  theRange.Offset(0, 3).Value = "High"
-  theRange.Offset(0, 4).Value = "Low"
-  theRange.Offset(0, 5).Value = "Close"
-  theRange.Offset(0, 6).Value = "Res"
-  theRange.Offset(0, 7).Value = "Supp"
-  Dim t As Integer, k As Integer
-  Dim i As Integer, j As Integer
-  i = 1: j = 1
-  For t = 1 To pPD.tC
-      theRange.Offset(t, 0).Value = t
-      theRange.Offset(t, 1).Value = pPD.D(t)
-      theRange.Offset(t, 2).Value = pPD.Opn(t)
-      theRange.Offset(t, 3).Value = pPD.Hgh(t)
-      theRange.Offset(t, 4).Value = pPD.Lw(t)
-      theRange.Offset(t, 5).Value = pPD.Cls(t)
-      If t >= pDen.tRes(1) Then
-        theRange.Offset(t, 6).Value = pDen.Res(t)
-      End If
-     If t >= pDen.tSupp(1) Then
-        theRange.Offset(t, 7).Value = pDen.Supp(t)
-     End If
-     If t = pDen.tRes(i) Then   'temp
-        theRange.Offset(t, 3).Interior.ColorIndex = 4
-        i = i + 1
-     End If
-     If t = pDen.tSupp(j) Then  'temp
-        theRange.Offset(t, 4).Interior.ColorIndex = 8
-        j = j + 1
-     End If
- Next t
-End Sub
-
-'*****************************************
-Sub DetDenmark(pPD As PriceData, pDen As Denmark)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPD  - ����, ����������� ����� ������ �� ����� (����������)
-' ���������:
-' pDen - �������� ������ �������� (������ ��������, pSig - ���������):
-' ����� Res,Supp �� �������, ������� �����, ������� � ������� ��� �������
-' Signal = 0 ������ �����������
-' Signal < 0 ������ ����������� ������ (������ �������)
-' Signal > 0 ������ ����������� ������ (������ �������)
-' ���� pDen.nRes < 2, �� �������� Res �� ������������
-' ���� pDen.nSupp < 2, �� �������� Supp �� ������������
-
-' ��������� ���������
-  Dim i As Integer
-  pDen.Signal = 0
-  For i = 1 To 3
-     pDen.Qual(i) = "-"
-  Next i
-
-' ����������� ����� ��������� � �������������
-  ResLine pPD.Hgh, pPD.tC, pDen.nRes, pDen.Res, pDen.tRes
-  SuppLine pPD.Lw, pPD.tC, pDen.nSupp, pDen.Supp, pDen.tSupp
-  If pDen.nRes >= 2 Then
-       pDen.AnglRes = 57.29578 * _
-       Atn(pDen.Res(pPD.tC) - pDen.Res(pPD.tC - 1))
-  End If
-  If pDen.nSupp >= 2 Then
-       pDen.AnglSupp = 57.29578 * _
-       Atn(pDen.Supp(pPD.tC) - pDen.Supp(pPD.tC - 1))
-  End If
-
-' ������������ ������� ----------------------------------
-  Dim t As Integer
-' 1. ������ ����������� ������: Res ��������� � Res ������ *************
-  If pDen.nRes >= 2 And pDen.AnglRes < 0 Then
-'    ����������� ������� ������� �����
-     If pDen.Res(pPD.tC) < pPD.Cls(pPD.tC) Then
-        pDen.Signal = 1
-        For t = pPD.tC - pDen.pSig To pPD.tC - 1
-           If pPD.Cls(t) > pDen.Res(t) Then
-             pDen.Signal = 0
-             Exit For
-           End If
-        Next t
-     End If
-     If pDen.Signal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-        If pPD.Cls(pPD.tC - 2) > pPD.Cls(pPD.tC - 1) Then
-           pDen.Signal = pDen.Signal + 1
-           pDen.Qual(1) = "*"
-        End If
-'       Qualificator-2: open > Res � ������ �������
-        If pPD.Opn(pPD.tC) > pDen.Res(pPD.tC) Then
-            pDen.Signal = pDen.Signal + 1
-            pDen.Qual(2) = "*"
-        End If
-'       Qualificator-3 - demand value < Res(tC)
-        If 2 * pPD.Cls(pPD.tC - 1) - pPD.Lw(pPD.tC - 1) < pDen.Res(pPD.tC) Then
-           pDen.Signal = pDen.Signal + 1
-           pDen.Qual(3) = "*"
-        End If
-     End If
-  End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: supp ��������� � supp ������
-  If pDen.nSupp >= 2 And pDen.AnglSupp > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-     If pPD.Cls(pPD.tC) < pDen.Supp(pPD.tC) Then
-        pDen.Signal = -1
-        For t = pPD.tC - pDen.pSig To pPD.tC - 1
-           If pPD.Cls(t) < pDen.Supp(t) Then
-             pDen.Signal = 0
-             Exit For
-           End If
-        Next t
-     End If
-     If pDen.Signal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-        If pPD.Cls(pPD.tC - 2) < pPD.Cls(pPD.tC - 1) Then
-           pDen.Signal = pDen.Signal - 1
-           pDen.Qual(1) = "*"
-        End If
-'       Qualificator-2: Open ���� Res � ������ �������
-        If pPD.Opn(pPD.tC) < pDen.Supp(pPD.tC) Then
-           pDen.Signal = pDen.Signal - 1
-           pDen.Qual(2) = "*"
-        End If
-'       Qualificator-3 - supply value(t-1) > Supp(tC)
-        If 2 * pPD.Cls(pPD.tC - 1) - pPD.Hgh(pPD.tC - 1) > pDen.Supp(pPD.tC) Then
-           pDen.Signal = pDen.Signal - 1
-           pDen.Qual(3) = "*"
-        End If
-     End If
-'    ---------------------------------------------
-  End If
-End Sub
-Sub DetProj(pPD As PriceData, pDen As Denmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-Dim pM As Double, t As Integer, tM As Integer, tL As Integer
-
-If pDen.Signal >= 2 Then  ' ������ �������
-
-   tL = pDen.tRes(pDen.nRes)     ' tR determination
-   If tL = pPD.tC Then
-      tL = pDen.tRes(pDen.nRes - 1)
-   End If
-
-'  Projections 1,2 --------------------------------------------
-   If pDen.nPj >= 1 And pDen.nPj <= 2 Then
-'       t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < Res(t)},
-        tM = pPD.tC - 1
-        pM = pPD.Lw(tM) ' L(t-1) < Res(t-1) for t - break point !
-        For t = pPD.tC - 2 To tL Step -1
-          If pPD.Lw(t) < pM And pPD.Lw(t) < pDen.Res(t) Then
-             pM = pPD.Lw(t): tM = t
-          End If
-        Next t
-'       t* is defined
-        If pDen.nPj = 1 Then
- '       P1( tb) = Res(tb) + Res(t*) - L(t*)
-           pDen.Pj = pDen.Res(pPD.tC) + pDen.Res(tM) - pPD.Lw(tM)
-        Else
-           pDen.Pj = pDen.Res(pPD.tC) + pDen.Res(tM) - pPD.Cls(tM)
-        End If
-   End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-   If pDen.nPj = 3 Then
-'      t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < Res(t)}
-       tM = pPD.tC - 1
-       pM = pPD.Cls(tM)
-       For t = pPD.tC - 2 To tL Step -1
-          If pPD.Cls(t) < pM And pPD.Cls(t) < pDen.Res(t) Then
-             pM = pPD.Cls(t): tM = t
-          End If
-       Next t
-'      t* is defined
-       pDen.Pj = pDen.Res(pPD.tC) + pDen.Res(tM) - pPD.Cls(tM)
-   End If
-End If
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-If pDen.Signal <= -2 Then
-   tL = pDen.tSupp(pDen.nSupp)  ' tR determination
-   If tL = pPD.tC Then
-      tL = pDen.tRes(pDen.nSupp - 1)
-   End If
-
-'  Projections 1,2 --------------------------------------------
-   If pDen.nPj = 1 Or pDen.nPj = 2 Then
-'       t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > Supp(t)},
-        tM = pPD.tC - 1
-        pM = pPD.Hgh(tM) ' H(t-1) > Supp(t-1) for t - break point !
-        For t = pPD.tC - 2 To tL Step -1
-          If pPD.Hgh(t) > pM And pPD.Hgh(t) > pDen.Supp(t) Then
-             pM = pPD.Hgh(t): tM = t
-          End If
-        Next t
-'       t* is defined
-        If pDen.nPj = 1 Then
- '         P1( tb) = Supp(tb) + Supp(t*) - H(t*)
-           pDen.Pj = pDen.Supp(pPD.tC) + pDen.Supp(tM) - pPD.Hgh(tM)
-        Else
-'          P2( tb) = Supp(tb) + Supp(t*) - C(t*)
-           pDen.Pj = pDen.Supp(pPD.tC) + pDen.Supp(tM) - pPD.Cls(tM)
-        End If
-   End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-   If pDen.nPj = 3 Then
-'     t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  Supp(t)}
-'     P3( tb) = Supp(tb) + Supp(t*) - C(t*)
-      tM = pPD.tC - 1
-      pM = pPD.Cls(tM)
-      For t = pPD.tC - 2 To tL Step -1
-          If pM < pPD.Cls(t) And pPD.Cls(t) > pDen.Supp(t) Then
-             pM = pPD.Cls(t): tM = t
-          End If
-      Next t
-'      t* is defined
-      pDen.Pj = pDen.Supp(pPD.tC) + pDen.Supp(tM) - pPD.Cls(tM)
-   End If
-End If
-End Sub
-
-Sub ResLine(High() As Double, tE As Integer, nRes As Integer, _
-            Res() As Double, s() As Integer)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ���������:
-' 1) ����� ������������� Res, dom(Res)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(nRes)}, s(1) < s(2) < ...< s(nRes)
-'   ( s(nRes)<= tE )- ������� �����
-' 3) ����� ������� ����� nRes.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� Supp
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
- Dim t As Integer, i As Integer
- Dim v As Double
-'1 ����������� ������� �������� �������
- nRes = 0
- For t = 2 To tE - 1
- '   v = max{high(t-1), high(t+1)} < high(t)
-     v = High(t - 1)
-     If v < High(t + 1) Then
-        v = High(t + 1)
-     End If
-     If High(t) > v Then    'alt.: v >= High(t + 1)
-        s(nRes + 1) = t: nRes = nRes + 1
-     End If
- Next t
- If nRes < 2 Then
-    GoTo done
- End If
-' 2 ����������� ����� �������������
- Res(s(1)) = High(s(1))
- For i = 2 To nRes
-    Res(s(i)) = High(s(i))
-    v = (High(s(i)) - High(s(i - 1))) / (s(i) - s(i - 1))
-    For t = s(i - 1) + 1 To s(i) - 1
-        Res(t) = High(s(i - 1)) + v * (t - s(i - 1))
-    Next t
- Next i
- If s(nRes) < tE Then
-    v = (High(s(nRes)) - High(s(nRes - 1))) / (s(nRes) - s(nRes - 1))
-    For t = s(nRes) + 1 To tE
-        Res(t) = High(s(nRes - 1)) + v * (t - s(nRes - 1))
-    Next t
- End If
-done:
-End Sub
-
-Sub SuppLine(Low() As Double, tE As Integer, nSupp As Integer, _
-               Supp() As Double, s() As Integer)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ���������:
-' 1) ����� ������������� Supp, dom(Supp)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(nSupp)}, s(1) < s(2) < ...< s(nSupp) -
-'    ������� �����
-' 3) ����� ������� ����� nSupp.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
- Dim t As Integer, i As Integer
- Dim v As Double
-'1 ����������� ������� �������� �������
- nSupp = 0
- For t = 2 To tE - 1
-'     v = min{Low(t-1), Low(t+1)} > Low(t)
-      v = Low(t - 1)
-      If v > Low(t + 1) Then
-         v = Low(t + 1)
-      End If
-      If Low(t) < v Then    'alt.: v >= High(t + 1)
-         s(nSupp + 1) = t: nSupp = nSupp + 1
-      End If
- Next t
- If nSupp < 2 Then
-    GoTo done
- End If
-' 2 ����������� ����� ���������
- Supp(s(1)) = Low(s(1))
- For i = 2 To nSupp
-    Supp(s(i)) = Low(s(i))
-    v = (Low(s(i)) - Low(s(i - 1))) / (s(i) - s(i - 1))
-    For t = s(i - 1) + 1 To s(i) - 1
-        Supp(t) = Low(s(i - 1)) + v * (t - s(i - 1))
-    Next t
- Next i
- If s(1) < tE Then
-    v = (Low(s(nSupp)) - Low(s(nSupp - 1))) / (s(nSupp) - s(nSupp - 1))
-    For t = s(nSupp) + 1 To tE
-        Supp(t) = Low(s(nSupp - 1)) + v * (t - s(nSupp - 1))
-    Next t
- End If
-done:
-End Sub
-
-Sub InitPriceData(p As PriceData, tE As Integer)
-' ������������� ������ �� �����
-  p.tC = tE
-  ReDim p.D(1 To tE)
-  ReDim p.Opn(1 To tE)
-  ReDim p.Hgh(1 To tE)
-  ReDim p.Lw(1 To tE)
-  ReDim p.Cls(1 To tE)
-  ReDim p.Vl(1 To tE)
-End Sub
-
-
-
-<<<<<<
-======================
-mTester1
->>>>>>
-Attribute VB_Name = "mTester1"
-Option Explicit
-Dim HISTORY As PriceData
-
-Sub Test1Denmark_Click()
-  
-  Dim nWin As Integer, nHist As Integer, _
-      theList As String, thePoint As String, _
-      Shift As Integer, pDen As Integer, pEMA As Integer
-' ������ ������-------------------------------
-  theList = Range("C4").Value     '������
-  thePoint = Range("C5").Value    '������
-  nHist = Range("C6").Value       '�������
-  nWin = Range("C7").Value        '����
-  pEMA = Range("C8").Value        '������� ��. ���������
-  Shift = Range("C9").Value       '�������� > 0
-  pDen = Range("C10").Value       '�������� Den
-' --------------------------------------------
-  Range("B16:H366").ClearContents
-
-' ����������� ��������� �������
-  InitPriceData p:=HISTORY, tE:=nHist   ' ������ ��� HISTORY
-  Worksheets(theList).Select            ' ����� ����� � �������
-  ReadData1 aPoint:=thePoint, Hist:=HISTORY.tC, dt:=1, p:=HISTORY
-' ���������� �������� ������� ���  HISTORY
-  
-  Worksheets("Testing").Select
-  Dim Win As PriceData, Den As Denmark
-  InitPriceData Win, nWin  ' ������ ��� ����
-  InitDenmark Den, nWin    ' ������ ��� Den ������(Den) = ������(Win)
-  Den.pSig = pDen
-  
-  
-  Dim theRange As Range
-  Set theRange = ActiveSheet.Range("B16")  '����� ������ ���. ������
-  
-  Dim t As Integer, i As Integer
-  Dim Sig As Integer, nSucc As Integer, nFall As Integer, Num As Integer
-  ReDim mov(1 To HISTORY.tC) As Double
-  Num = 0: nSucc = 0: nFall = 0
-  ExpMA1 HISTORY.Cls, 1, HISTORY.tC, 2 / (pEMA + 1), mov ' moving averige
-  
-  For t = Win.tC To HISTORY.tC - Shift   ' nWin  <= t <= P_DEN.tC
-'     ����������� ������� �� ������ t  �� ���� Win
-      Sig = DenSignal(t, Win, HISTORY, Den)
-      If Sig <> 0 Then
-         If Sig * Sign((mov(t + Shift) - mov(t))) >= 0 Then
-               nSucc = nSucc + 1
-         Else
-               nFall = nFall + 1
-         End If
-         Num = Num + 1
-      End If
-      theRange.Offset(t - nWin, 0).Value = t
-      theRange.Offset(t - nWin, 1).Value = HISTORY.D(t)
-      theRange.Offset(t - nWin, 2).Value = HISTORY.Opn(t)
-      theRange.Offset(t - nWin, 3).Value = HISTORY.Hgh(t)
-      theRange.Offset(t - nWin, 4).Value = HISTORY.Lw(t)
-      theRange.Offset(t - nWin, 5).Value = HISTORY.Cls(t)
-      If Sig <> 0 Then
-         theRange.Offset(t - nWin, 6).Value = Sig
-      End If
-  Next t
-  
-  Set theRange = ActiveSheet.Range("F4")  '����� ������ ���. ������
-  theRange.Offset(0, 0).Value = Num
-  theRange.Offset(0, 1).Value = nSucc
-  theRange.Offset(0, 2).Value = nFall
-  theRange.Offset(0, 3).Value = nSucc / Num
-  
-  
-End Sub
-
-Function DenSignal(t As Integer, _
-                   Win As PriceData, _
-                   Hist As PriceData, _
-                   Den As Denmark) As Integer
-                   
-' ������ � ������� ��� ������� �� ��������
-' �������� ������:
-' 1. t - ������ �������, �� ������� ������������ ������
-'    win.tC <= t <= Hist.tC
-' 2. win.tC -������ ���������� ����, �� �������� ������������  ����� ��������
-'    ������ ��� ���� ��������.
-' 3. Hist - �������, �������� ������� ��������� ����������.
-' 4. Den.pSig - �������� �������, ������ ��� Den ��������
-' ���������:
-' DenSignal >= 1 -  ������ � ������� ~ ��������� ���������
-' DenSignal =  0 -  ������� ���
-' DenSignal <= -1 - ������ � ������� ~ ��������� ���������
-' * ���������� �������� DenSignal = ����� ������������� ��������������
-
-' ����������� ����
-  Dim i As Integer
-  For i = 1 To Win.tC
-      Win.D(i) = Hist.D(t - Win.tC + i)
-      Win.Cls(i) = Hist.Cls(t - Win.tC + i)
-      Win.Opn(i) = Hist.Opn(t - Win.tC + i)
-      Win.Hgh(i) = Hist.Hgh(t - Win.tC + i)
-      Win.Lw(i) = Hist.Lw(t - Win.tC + i)
-  Next i
-  DetDenmark Win, Den  '�������� �������� ���������� ��� t
-  If Den.Signal > 1 Then
-     DenSignal = Den.Signal - 1
-  End If
-  If Den.Signal < -1 Then
-     DenSignal = Den.Signal + 1
-  End If
-End Function
-
-Function Sign(x As Double) As Integer
-    Sign = 0
-    If x > 0 Then
-       Sign = 1
-    ElseIf x < 0 Then
-       Sign = -1
-    End If
-End Function
-
-' ���������������� ���������� �������
-Sub ExpMA1(x() As Double, t1 As Integer, t2 As Integer, alfa As Double, _
-           s() As Double)
-' x , dom(x) = [t1,t2], - �������� ���
-' 0 <= alfa <= 1 - ������� �����������
-' alfa = 2/(nWin+1)
-' alfa <= 0 --> s = 0; alfa => 1 s = x
-' ���������: S , dom(S) = [t1,t2], - ���������� �������
-Dim S0 As Double, beta As Double
-Dim k As Integer, t As Integer
-' S0 determination
-If alfa <= 0 Then
-   For t = t1 To t2
-      s(t) = 0
-   Next t
-   GoTo done
-End If
-If alfa >= 1 Then
-   For t = t1 To t2
-      s(t) = x(t)
-   Next t
-   GoTo done
-End If
-S0 = 0
-k = 5    ' ������� ����������, k < (t2-t1+1)/2  !!!
-For t = t1 To t1 + k - 1
-    S0 = S0 + x(t)
-Next t
-S0 = S0 / k
-'main cycle
-beta = 1 - alfa
-s(t1) = alfa * x(t1) + beta * S0
-For t = t1 + 1 To t2
-    s(t) = alfa * x(t) + beta * s(t - 1)
-Next t
-done:
-End Sub
-
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'Denmark_method'
-Quirk - duff tag length======================
-MGetWebData
->>>>>>
-Attribute VB_Name = "MGetWebData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Const QueryDataName As String = "ExternalDenmarkData"
-
-Function UpdateHistoryFromWeb(wb As Workbook) As Boolean
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    UpdateHistoryFromWeb = False
-    QryPathStr = GetQryPath(wb)
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW")
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = IsNumeric(.Range("DEN_TIME"))
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table and temp area
-            With .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE))
-                .ClearContents
-                .NumberFormat = "General"
-            End With
-            
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-    
-'            .Parent.Application.DisplayAlerts = False
-    
-            If ResultLength < denWindow Then
-                Exit Function
-            End If
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                OtherChar:="|", _
-                FieldInfo:=Array( _
-                                Array(1, xlSkipColumn), _
-                                Array(2, xlTextFormat), _
-                                Array(3, xlGeneralFormat), _
-                                Array(4, xlGeneralFormat), _
-                                Array(5, xlGeneralFormat), _
-                                Array(6, xlGeneralFormat), _
-                                Array(7, xlGeneralFormat), _
-                                Array(8, xlSkipColumn), _
-                                Array(9, xlSkipColumn), _
-                                Array(10, xlSkipColumn), _
-                                Array(11, xlSkipColumn), _
-                                Array(12, xlSkipColumn))
-            
-            .Range(DestRangeName).EntireColumn.AutoFit
-            
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).NumberFormat = "General"
-            
-            Dim RawData As Range
-            Dim row_idx As Integer
-            
-            Set RawData = .Range(DestRangeName).Offset(0, 1)
-            RawData.Insert Shift:=xlToRight
-            
-            If Not IsIntraday Then
-                Set RawData = RawData.Offset(0, -1)
-                RawData.Value = "18:00"
-                RawData.Cells(1, 1).FormulaR1C1 = "TIME"
-                Set RawData = RawData.Offset(0, -1)
-            Else
-                Set RawData = RawData.Offset(0, -2)
-                RawData.TextToColumns _
-                    Destination:=RawData, _
-                    DataType:=xlDelimited, _
-                    TextQualifier:=xlDoubleQuote, _
-                    ConsecutiveDelimiter:=False, _
-                    Tab:=False, _
-                    Semicolon:=False, _
-                    Comma:=False, _
-                    Space:=True, _
-                    Other:=False, _
-                    OtherChar:="/", _
-                    FieldInfo:=Array( _
-                                    Array(1, xlTextFormat), _
-                                    Array(2, xlTextFormat))
-                RawData.Cells(1, 2).FormulaR1C1 = "TIME"
-            End If
-            
-'            Dim end_date As Date
-'            end_date = RawData.Cells(ResultLength, 1).FormulaR1C1
-
-' Delete unused space
-            
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + ResultLength, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            Dim i As Integer
-' Delete blank intervals
-            
-            Set RawData = .Range(RAW_DATA_RANGE).Offset(0, 0)
-            row_idx = 0
-            For i = 1 To ResultLength
-                ' skip virtual prices
-                If RawData.Offset(row_idx, CLOSE_IDX).Value > MIN_PRICE_VALUE Then
-                    row_idx = row_idx + 1
-                Else
-                    Set Location = .Range( _
-                            .Cells(row_idx + RAW_DATA_RANGE_ROW, DATE_IDX + RAW_DATA_RANGE_COL), _
-                            .Cells(row_idx + RAW_DATA_RANGE_ROW, PROJECT_IDX + RAW_DATA_RANGE_COL) _
-                    )
-                    Location.Delete xlShiftUp
-                End If
-            Next i
-            
-            ResultLength = GetLinesCount(.Range(RAW_DATA_RANGE))
-            
-            row_idx = ResultLength - 1
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).Delete xlShiftUp
-            Else
-                Exit Function
-            End If
-            
-            Dim TmpStr As String
-                        
-            row_idx = GetLinesCount(.Range(RAW_DATA_RANGE))
-            
-            Set RawData = .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx - 1, RAW_DATA_RANGE_COL + DATE_IDX) _
-                )
-            RawData.TextToColumns _
-                Destination:=.Range(RAW_DATA_RANGE).Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="-", _
-                FieldInfo:=Array( _
-                                Array(1, xlTextFormat), _
-                                Array(2, xlTextFormat), _
-                                Array(3, xlTextFormat))
-            
-            Set Location = .Range(RAW_DATA_RANGE).Offset(0, -1)
-            
-            If IsIntraday Then
-                Set RawData = .Range( _
-                            .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + TIME_IDX), _
-                            .Cells(RAW_DATA_RANGE_ROW + row_idx - 1, RAW_DATA_RANGE_COL + TIME_IDX) _
-                    )
-                RawData.TextToColumns _
-                    Destination:=.Range(RAW_DATA_RANGE).Offset(0, TIME_STAMP_OFFSET), _
-                    DataType:=xlDelimited, _
-                    TextQualifier:=xlDoubleQuote, _
-                    ConsecutiveDelimiter:=False, _
-                    Tab:=False, _
-                    Semicolon:=False, _
-                    Comma:=False, _
-                    Space:=False, _
-                    Other:=True, _
-                    OtherChar:=":", _
-                    FieldInfo:=Array( _
-                                    Array(1, xlTextFormat), _
-                                    Array(2, xlTextFormat), _
-                                    Array(3, xlTextFormat))
-                                    
-                
-                For i = 0 To row_idx - 1
-                    Location.Offset(i, 0) = "'" & _
-                            .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 1).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 2).Value _
-                            & "-" & .Range(RAW_DATA_RANGE).Offset(i, TIME_STAMP_OFFSET).Value _
-                            & ":" & .Range(RAW_DATA_RANGE).Offset(i, TIME_STAMP_OFFSET + 1).Value
-                Next
-            Else
-                For i = 0 To row_idx - 1
-                    Location.Offset(i, 0) = "'" & _
-                            .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 2).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 1).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET).Value
-                Next
-            End If
-            .Parent.Application.DisplayAlerts = True
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromWeb = True
-End Function
-
-Private Function GetQryPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    Dim IsIntradai As Boolean
-    Dim DayCount As Integer
-    Const DataFormat As String = "&data_format=BROWSER"
-    With wb.Worksheets(VAR_SHEET)
-        IsIntradai = IsNumeric(.Range("DEN_TIME"))
-        
-        If IsIntradai Then
-        
-            QryPathStr = "URL;http://export.rbc.ru/export/"
-            QryPathStr = QryPathStr & .Range("DEN_SOURCE")
-            QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-            QryPathStr = QryPathStr & "/?"
-            
-            QryPathStr = QryPathStr & "tickers=" & .Range("DEN_SYMBOL")
-            QryPathStr = QryPathStr & "&period=" & .Range("DEN_TIME")
-            QryPathStr = QryPathStr & "&virtual=PASS"
-            DayCount = .Range("DEN_HISTORY") * .Range("DEN_TIME") \ 420 + 1
-            QryPathStr = QryPathStr & "&lastdays=" & DayCount
-            QryPathStr = QryPathStr & "&separator=,"
-            QryPathStr = QryPathStr & DataFormat
-            QryPathStr = QryPathStr & "&header=1"
-        Else
-            QryPathStr = "URL;http://export.rbc.ru/cgi-bin/export/query_version/export.cgi?"
-            QryPathStr = QryPathStr & "&sourcename=" & .Range("DEN_SOURCE")
-            QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-            QryPathStr = QryPathStr & "&tickers=" & .Range("DEN_SYMBOL")
-            QryPathStr = QryPathStr & "&period=DAILY"
-            QryPathStr = QryPathStr & "&virtual=PASS"
-            QryPathStr = QryPathStr & "&lastdays=" & .Range("DEN_HISTORY") + 1
-            QryPathStr = QryPathStr & "&separator=,"
-            QryPathStr = QryPathStr & DataFormat
-            QryPathStr = QryPathStr & "&header=1"
-        End If
-    .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-End Function
-
-Sub UpdateTickerList(wb As Workbook)
-    Dim Idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    QryPathStr = GetListPath(wb)
-    With wb
-        With .Worksheets(VAR_SHEET)
-            Idx = .Range("IDX_DEN_LIST")
-            Set Location = .Range("TICKER_TABLES").Offset(0, (Idx - 1) * 2)
-             .Range("IDX_DEN_SYMBOL") = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-        
-            .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 0), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-        ' Setup Ticker List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        ' Setup Name List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Offset(0, 1).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        .Parent.Application.DisplayAlerts = True
-    End With
-End Sub
-
-Private Function GetListPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://export.rbc.ru/cgi-bin/export/tickers.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-        .Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            ThisWorkbook.Save
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(FORM_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mReadWrite
->>>>>>
-Attribute VB_Name = "mReadWrite"
-Option Explicit
-
-Public Const GOOD_LINE_STATUS As String = "Ok"
-Public Const BAD_LINE_STATUS As String = "N/A"
-
-Function ReadPricesData(Location As Range, Hist As Integer, dt As Integer, _
-              pPriceData As TPriceData) As Integer
-    '������������� ���� TPriceData �� ������� ���� - 1
-    'k��������� �� ����� ��� hist ��������� �����
-    'aPoint - ������ �������
-    '������ ��� ������ ������� �������������� ������ (������)
-    Dim n, i As Integer
-    
-    '����������� ����� ����� ������� - n
-    n = GetLinesCount(Location)
-    ReadPricesData = n
-    If n < 9 Then             '���������� ������ !!!
-        GoTo done
-    End If
-    ' ����� ����� ���������� ()
-    If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-        Hist = (n - 3) \ dt + 1 '
-    End If
-    Dim t, s As Integer
-    For t = 0 To Hist - 1
-        s = n - t * dt - 1
-        pPriceData.D(Hist - t) = Location.Offset(s, DATE_IDX).Value
-        pPriceData.Tm(Hist - t) = Location.Offset(s, TIME_IDX).Value
-        pPriceData.Opn(Hist - t) = Location.Offset(s, OPEN_IDX).Value
-        pPriceData.Hgh(Hist - t) = Location.Offset(s, HIGH_IDX).Value
-        pPriceData.Lw(Hist - t) = Location.Offset(s, LOW_IDX).Value
-        pPriceData.Cls(Hist - t) = Location.Offset(s, CLOSE_IDX).Value
-        pPriceData.Vl(Hist - t) = Location.Offset(s, VOLUME_IDX).Value
-    Next t
-    ReadPricesData = t + 1
-done:
-End Function
-
-Sub ResultLinesOut(Location As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim n As Integer
-    
-    n = GetLinesCount(Location)
-    With Location
-        .Offset(-1, RESIST_IDX) = "Resistance"
-        .Offset(-1, SUPPORT_IDX) = "Support"
-        .Offset(-1, PROJECT_IDX) = "Project"
-    End With
-    Dim t, count, Idx, loc_idx As Integer
-    count = pPD.tC
-    For t = 0 To count - 1
-        Idx = count - t
-        loc_idx = n - t - 1
-        If pDen.ResistanceLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, RESIST_IDX).Value = pDen.ResistanceLine(Idx)
-        End If
-        If pDen.SupportLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, SUPPORT_IDX).Value = pDen.SupportLine(Idx)
-        End If
-        If Abs(pDen.SignalValue) > 1 Then
-            Location.Offset(loc_idx, PROJECT_IDX).Value = pDen.ProjectPrice
-        End If
-    Next t
-End Sub
-
-Sub Out_Table_1(TheRange As Range, pDen As TDenmark, LastIdx As Integer)
-    
-    
-    ' Col = 2 - �� ��������� !!!
-    ' Status - Col = 0
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(0, 0).Value = BAD_LINE_STATUS
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(1, 0).Value = BAD_LINE_STATUS
-    End If
-    ' -----------------------------------------
-    ' ���� �������� ����� ������������� � ��������� - Col = 1
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 1).Value = pDen.ResistanceAngle
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 1).Value = pDen.SupportAngle
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 1).Value = (pDen.ResistanceAngle + pDen.SupportAngle) / 2
-    End If
-    ' -----------------------------------------
-    ' ������� ���� ����� �������� �� ������� ������
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 2).Value = pDen.ResistanceLine(LastIdx)
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 2).Value = pDen.SupportLine(LastIdx)
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 2).Value = _
-            (pDen.ResistanceLine(LastIdx) + pDen.SupportLine(LastIdx)) / 2
-    End If
-    
-End Sub
-
-Sub Out_Table_2(TheRange As Range, TheComment As Range, pPD As TPriceData, pDen As TDenmark)
-    Const ColorIndexBUY = 5
-    Const ColorIndexSELL = 3
-    Const ColorIndexNOTHINK = 14
-    
-    Dim SignalValue_defined, allert_enable  As Boolean
-    Dim Message As String
-    SignalValue_defined = False
-    allert_enable = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_ALLERT_DLG")
-    Message = "������ �� ��������� ������ �� ���������������."
-    If pDen.SignalValue >= 2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "BUY"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexBUY
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue - 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "BUY Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & pDen.SignalValue - 1 & " ! "
-    End If
-    If pDen.SignalValue <= -2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "SELL"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexSELL
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue + 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "SELL Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(pDen.SignalValue + 1) & "!"
-    End If
-    With TheComment
-        .Value = Message
-        .Font.Bold = True
-        Dim color_idx As Integer
-        If SignalValue_defined Then
-            If pDen.SignalValue > 0 Then
-                .Font.ColorIndex = ColorIndexBUY
-            Else
-                .Font.ColorIndex = ColorIndexSELL
-            End If
-        Else
-            .Font.ColorIndex = ColorIndexNOTHINK
-        End If
-    End With
-    If allert_enable And SignalValue_defined Then
-        MsgBox _
-            Prompt:=Message, _
-            Title:=PROGRAM_NAME, _
-            Buttons:=vbOKOnly + vbInformation
-    End If
-End Sub
-
-Sub Out_Table_3(TheRange As Range, pDen As TDenmark)
-    Dim i As Integer
-    For i = 1 To 3
-        TheRange.Offset(i - 1, 0).Value = pDen.Qualificator(i)
-    Next i
-End Sub
-
-Sub Out_Table_4(TheRange As Range, pPD As TPriceData)
-    Dim LastIdx As Integer
-    LastIdx = pPD.tC
-    With TheRange
-        .Offset(0, 0).Value2 = "'" & pPD.D(LastIdx)
-        .Offset(0, 1).Value2 = "'" & pPD.Tm(LastIdx)
-        .Offset(0, 2) = pPD.Opn(LastIdx)
-        .Offset(0, 3) = pPD.Hgh(LastIdx)
-        .Offset(0, 4) = pPD.Lw(LastIdx)
-        .Offset(0, 5) = pPD.Cls(LastIdx)
-        .Offset(0, 6) = pPD.Cls(LastIdx) - pPD.Cls(LastIdx - 1)
-    End With
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Denmark method bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-    End With
-    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(wb As Workbook)
-    With wb
-        .Application.ScreenUpdating = False
-        
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(FORM_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-            .Select
-        End With
-        With .Worksheets(CHART_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-        End With
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(wb As Workbook)
-    With wb
-        .Unprotect
-        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Unprotect
-        End With
-        With .Worksheets(FORM_SHEET)
-            .Select
-            .Unprotect
-        End With
-        .Application.ScreenUpdating = True
-        
-    End With
-End Sub
-
-<<<<<<
-======================
-mTypes
->>>>>>
-Attribute VB_Name = "mTypes"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "����� �-�� ������� II"
-Public Const PROGRAM_VERSION As String = "version 4.1 Professional"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-Public Const ESTIMATION_DATE As Long = 20010615
-'Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "J27"
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const PRICE_TABLE As String = "B1"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-Public Const VAR_SHEET As String = "Var_s"
-
-Public Const CHART_SHEET As String = "Chart"
-
-Public Const MIN_PRICE_VALUE As Double = 0.000001
-Public Const MAX_PRICE_VALUE As Double = 1000000000
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const HIGH_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const CLOSE_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const RESIST_IDX As Integer = 7
-Public Const SUPPORT_IDX As Integer = 8
-Public Const PROJECT_IDX As Integer = 9
-
-Public Const DATE_STAMP_OFFSET = PROJECT_IDX + 1
-Public Const TIME_STAMP_OFFSET = PROJECT_IDX + 4
-Public Const DATE_TIME_STAMP_SIZE = 5
-
-Type TPriceData
-    D() As String      ' ����������� ����
-    Tm() As String     ' �����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Double     ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type TDenmark
-   ResistanceLine() As Double           'Resistance line
-   ResistancePoints() As Integer        'Resistance pivot points
-   ResistancePointCount As Integer      'The number of resistance pivot points
-   ResistanceAngle As Double            'Angle of Declination of ResistanceLine
-   
-   SupportLine() As Double              'Support line
-   SupportPoints() As Integer           'Support pivot points
-   SupportPointsCount As Integer        'The number of support pivot points
-   SupportAngle As Double               ' Angle of Declination of SupportLine
-   
-   SignalParameter     As Integer       ' parameter for SignalValue
-   SignalValue      As Integer          'SignalValue
-   
-   
-   Qualificator(1 To 3) As String       ' qualificators
- 
-   ProjectNumber As Integer             ' ����� ��������
-   ProjectPrice  As Double              ' �������� ����
-   
-End Type
-
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-Dim AppRunEnable As New cEnableRun
-
-Sub evParamChange()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = True Then
-        evSubmit_Click
-    End If
-End Sub
-
-Sub cmViewChart(Optional SwapPage As Boolean = True)
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_CHART_READY") = False
-        If .Range("BOOL_DEMARK_READY") <> True Then
-            If .Range("BOOL_AUTORECALC") = True Then
-                evSubmit_Click
-                If .Range("BOOL_DEMARK_READY") <> True Then
-                    Exit Sub
-                End If
-            Else
-                MsgBox _
-                    "������ �� ����� ���� ��������." & vbCrLf & "�������� ������ �� ����������.", _
-                    vbOKOnly + vbExclamation, _
-                    PROGRAM_NAME
-                Exit Sub
-            End If
-        End If
-    End With
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        With .Range("TABLE_1")
-            Dim test_lines As Boolean
-            test_lines = StrComp(.Cells(1, 1).Value, GOOD_LINE_STATUS)
-            test_lines = test_lines + StrComp(.Cells(2, 1).Value, GOOD_LINE_STATUS)
-            If test_lines <> 0 Then
-                MsgBox _
-                    Prompt:="������ �� ����� ���� ��������." & vbCrLf & "������� ����� �� ���������� .", _
-                    Title:=PROGRAM_NAME, _
-                    Buttons:=vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End With
-        Draw_Chart Not IsEmpty(.Range("TABLE_2").Cells(1, 1))
-    End With
-    With ThisWorkbook
-        .Worksheets(VAR_SHEET).Range("BOOL_CHART_READY") = True
-        If SwapPage Then
-            .Worksheets(CHART_SHEET).Select
-        End If
-    End With
-End Sub
-
-Sub cmViewForm()
-    With ThisWorkbook
-        .Worksheets(FORM_SHEET).Select
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Dim ResistanceLine
-    ResistanceLine = MsgBox( _
-        Prompt:="�� ������� ��������� ���������?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If ResistanceLine = vbYes Then
-       Application.Quit
-    End If
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Demark.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable wb:=ThisWorkbook
-    SetEnvironment wb:=ThisWorkbook
-    ProtectionEnable wb:=ThisWorkbook
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable wb:=ThisWorkbook
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=True
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmPrint()
-    If MsgBox( _
-            Prompt:="�� ������� ����������� ���������?", _
-            Buttons:=vbYesNo + vbQuestion, _
-            Title:=PROGRAM_NAME) = vbNo _
-    Then
-        Exit Sub
-    End If
-    Dim s_ticker, s_name, s_time As String
-    s_ticker = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME")
-    s_name = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_NAME")
-    s_time = Now
-    Application.ScreenUpdating = False
-    cmViewChart SwapPage:=False
-    Application.ScreenUpdating = False
-    With ThisWorkbook.Worksheets(FORM_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    With ThisWorkbook.Worksheets(CHART_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    Application.ScreenUpdating = False
-    ThisWorkbook.Worksheets(Array("MainForm", "Chart")).PrintOut Copies:=1, Collate:=True
-    cmViewForm
-End Sub
-<<<<<<
-======================
-mDemark
->>>>>>
-Attribute VB_Name = "mDemark"
-Option Explicit
-
-Public Const FORM_SHEET As String = "MainForm"
-
-'Form Ranges
-Public Const FILE_NAME As String = "FILE_NAME"
-Public Const TABLE_1 As String = "TABLE_1"
-Public Const TABLE_2 As String = "TABLE_2"
-Public Const TABLE_3 As String = "TABLE_3"
-Public Const TABLE_4 As String = "TABLE_4"
-Public Const TABLE_COMMENT As String = "TABLE_COMMENT"
-
-'�������� ��� ������ - �������� 1
-
-'*********************
-Dim PriceDataArray As TPriceData
-Dim DenmarkDataArray As TDenmark
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Sub ClearResultTables()
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        .Range(TABLE_1).ClearContents ' �������-1
-        .Range(TABLE_2).ClearContents ' �������-2
-        .Range(TABLE_3).ClearContents ' �������-3
-        .Range(TABLE_COMMENT).Value = "" ' ����������-3
-        .Range(TABLE_4).ClearContents ' �������-4
-    End With
-End Sub
-
-Function TDenmark_Calc() As Boolean
-    
-    Dim nWindow As Integer
-    Dim bPrevCloseFilter, bSuccCloseFilter As Boolean
-    
-    TDenmark_Calc = False
-    
-    mobjAppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-'1)    Read User data
-        With .Worksheets(VAR_SHEET)
-            DenmarkDataArray.ProjectNumber = .Range("DEN_PROECT").Value
-            DenmarkDataArray.SignalParameter = .Range("DEN_PARAM").Value
-            nWindow = .Range("DEN_WINDOW").Value
-            bPrevCloseFilter = .Range("BOOL_PREV_CLOSE").Value
-            bSuccCloseFilter = .Range("BOOL_SUCC_CLOSE").Value
-        End With
-
-'2)   Memory allocation
-        allocate_memory PriceDataArray, DenmarkDataArray, nWindow
-
-'3)   Read data
-        Dim TheRange As Range
-        Set TheRange = .Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE)
-        Dim LinesCount As Integer
-        LinesCount = ReadPricesData(Location:=TheRange, Hist:=PriceDataArray.tC, dt:=1, pPriceData:=PriceDataArray)
-        
-        'Init function result
-        TDenmark_Calc = LinesCount >= nWindow
-        
-        If LinesCount >= nWindow Then
-        
-'4)   Calculate metod TDenmarkDataArray
-            DetDenmark PriceDataArray, DenmarkDataArray, bPrevCloseFilter, bSuccCloseFilter
-            If Abs(DenmarkDataArray.SignalValue) > 1 Then  '������� ���������, ���� ���� ������
-                DetProj PriceDataArray, DenmarkDataArray
-            End If
-'5)   Write result
-            Application.ScreenUpdating = False
-    
-'6)    Clear interface tables
-            ClearResultTables
-            
-            ResultLinesOut Location:=TheRange.Offset(2, 0), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-            
-            With .Worksheets(FORM_SHEET)
-                Out_Table_1 TheRange:=.Range(TABLE_1).Cells(1, 1), pDen:=DenmarkDataArray, LastIdx:=PriceDataArray.tC
-                Out_Table_2 _
-                        TheRange:=.Range(TABLE_2).Cells(1, 1), _
-                        TheComment:=.Range("TABLE_COMMENT"), _
-                        pPD:=PriceDataArray, _
-                        pDen:=DenmarkDataArray
-                Out_Table_3 TheRange:=.Range(TABLE_3).Cells(1, 1), pDen:=DenmarkDataArray
-                Out_Table_4 TheRange:=.Range(TABLE_4).Cells(1, 1), pPD:=PriceDataArray
-                With .Range(TABLE_1)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_2)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_3)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_4)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-            End With
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = True
-        Else
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-'7)   Free unused memory
-        free_unused_memory PriceDataArray, DenmarkDataArray
-    End With
-End Function
-
-Sub allocate_memory(pPriceData As TPriceData, pDenmarkData As TDenmark, memsize As Integer)
-'  ������ ��� TDenmark
-    ReDim pDenmarkData.ResistanceLine(1 To memsize)
-    ReDim pDenmarkData.ResistancePoints(1 To memsize)
-    ReDim pDenmarkData.SupportLine(1 To memsize)
-    ReDim pDenmarkData.SupportPoints(1 To memsize)
-   
-' ������������� ������ �� �����
-    pPriceData.tC = memsize
-    ReDim pPriceData.D(1 To memsize)
-    ReDim pPriceData.Tm(1 To memsize)
-    ReDim pPriceData.Opn(1 To memsize)
-    ReDim pPriceData.Hgh(1 To memsize)
-    ReDim pPriceData.Lw(1 To memsize)
-    ReDim pPriceData.Cls(1 To memsize)
-    ReDim pPriceData.Vl(1 To memsize)
-
-End Sub
-
-Sub free_unused_memory(pP As TPriceData, pD As TDenmark)
-'   Free Prices
-    pP.tC = 0
-    Erase pP.D
-    Erase pP.Tm
-    Erase pP.Opn
-    Erase pP.Hgh
-    Erase pP.Lw
-    Erase pP.Cls
-    Erase pP.Vl
-    
-'Free TDenmark
-    Erase pD.ResistanceLine
-    Erase pD.ResistancePoints
-    Erase pD.SupportLine
-    Erase pD.SupportPoints
-End Sub
-
-
-'*****************************************
-Sub DetDenmark(pPriceData As TPriceData, pDenmarkData As TDenmark, ByVal ClosePrev2 As Boolean, ByVal CloseSucc1 As Boolean)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPriceData  - ����, ����������� ����� ������ �� ����� (����������)
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' pDenmarkData - �������� ������ �������� (������ ��������, SignalParameter - ���������):
-' ����� ResistanceLine,SupportLine �� �������, ������� �����, ������� � ������� ��� �������
-' SignalValue = 0 ������ �����������
-' SignalValue < 0 ������ ����������� ������ (������ �������)
-' SignalValue > 0 ������ ����������� ������ (������ �������)
-' ���� pDenmarkData.ResistancePointCount < 2, �� �������� ResistanceLine �� ������������
-' ���� pDenmarkData.SupportPointsCount < 2, �� �������� SupportLine �� ������������
-
-' ��������� ���������
-    Const QUALIFICATOR_DISABLE As String = "-"
-    Const QUALIFICATOR_ENABLE As String = "Signal"
-    
-    Dim UpQual(1 To 3) As String
-    Dim DownQual(1 To 3) As String
-    Dim UpSignal, DownSignal As Integer
-    Dim i As Integer
-    
-    pDenmarkData.SignalValue = 0
-    UpSignal = 0
-    DownSignal = 0
-    
-    For i = 1 To 3
-        pDenmarkData.Qualificator(i) = QUALIFICATOR_DISABLE
-        UpQual(i) = QUALIFICATOR_DISABLE
-        DownQual(i) = QUALIFICATOR_DISABLE
-    Next i
-    
-' ����������� ����� ��������� � �������������
-    ResLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.ResistancePointCount, _
-        pDenmarkData.ResistanceLine, _
-        pDenmarkData.ResistancePoints, _
-        ClosePrev2, _
-        CloseSucc1
-        
-    SuppLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.SupportPointsCount, _
-        pDenmarkData.SupportLine, _
-        pDenmarkData.SupportPoints, _
-        ClosePrev2, _
-        CloseSucc1
-
-        
-        
-    If pDenmarkData.ResistancePointCount >= 2 Then
-        pDenmarkData.ResistanceAngle = 57.29578 * _
-            Atn(pDenmarkData.ResistanceLine(pPriceData.tC) - _
-                pDenmarkData.ResistanceLine(pPriceData.tC - 1))
-    End If
-    If pDenmarkData.SupportPointsCount >= 2 Then
-        pDenmarkData.SupportAngle = 57.29578 * _
-            Atn(pDenmarkData.SupportLine(pPriceData.tC) - _
-                pDenmarkData.SupportLine(pPriceData.tC - 1))
-    End If
-
-' ������������ ������� ----------------------------------
-    Dim t As Integer
-' 1. ������ ����������� ������: ResistanceLine ��������� � ResistanceLine ������ *************
-    If pDenmarkData.ResistancePointCount >= 2 And pDenmarkData.ResistanceAngle < 0 Then
-'    ����������� ������� ������� �����
-        If pDenmarkData.ResistanceLine(pPriceData.tC) < pPriceData.Cls(pPriceData.tC) Then
-            UpSignal = 1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) > pDenmarkData.ResistanceLine(t) Then
-                    UpSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If UpSignal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) > pPriceData.Cls(pPriceData.tC - 1) Then
-                UpSignal = UpSignal + 1
-                UpQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: open > ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) > pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - demand value < ResistanceLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Lw(pPriceData.tC - 1) < pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-    End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: SupportLine ��������� � SupportLine ������
-    If pDenmarkData.SupportPointsCount >= 2 And pDenmarkData.SupportAngle > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-        If pPriceData.Cls(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-            DownSignal = -1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) < pDenmarkData.SupportLine(t) Then
-                    DownSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If DownSignal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) < pPriceData.Cls(pPriceData.tC - 1) Then
-                DownSignal = DownSignal - 1
-                DownQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: Open ���� ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - supply value(t-1) > SupportLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Hgh(pPriceData.tC - 1) > pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-'    ---------------------------------------------
-    End If
-'      ���������� ������������ ���������
-    If Abs(DownSignal) <> UpSignal Then
-        If Abs(DownSignal) > UpSignal Then
-            pDenmarkData.SignalValue = DownSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = DownQual(i)
-            Next i
-        Else
-            pDenmarkData.SignalValue = UpSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = UpQual(i)
-            Next i
-        End If
-    End If
-End Sub
-
-Sub DetProj(pPriceData As TPriceData, pDenmarkData As TDenmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-    Dim pM As Double, t As Integer, Tm As Integer, tL As Integer
-
-    If pDenmarkData.SignalValue >= 2 Then  ' ������ �������
-
-        tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount)     ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2 Then
-'           t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < ResistanceLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Lw(Tm) ' L(t-1) < ResistanceLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Lw(t) < pM And pPriceData.Lw(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Lw(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
-'               P1( tb) = ResistanceLine(tb) + ResistanceLine(t*) - L(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Lw(Tm)
-            Else
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If ' pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < ResistanceLine(t)}
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Cls(t) < pM And pPriceData.Cls(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue >= 2
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-    If pDenmarkData.SignalValue <= -2 Then
-        tL = pDenmarkData.SupportPoints(pDenmarkData.SupportPointsCount)  ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.SupportPointsCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber = 1 Or pDenmarkData.ProjectNumber = 2 Then
-'           t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > SupportLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Hgh(Tm) ' H(t-1) > SupportLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Hgh(t) > pM And pPriceData.Hgh(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Hgh(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
- '              P1( tb) = SupportLine(tb) + SupportLine(t*) - H(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Hgh(Tm)
-            Else
-'               P2( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  SupportLine(t)}
-'           P3( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pM < pPriceData.Cls(t) And pPriceData.Cls(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue <= -2
-End Sub
-
-Sub ResLine(pP As TPriceData, tE As Integer, ResistancePointCount As Integer, _
-            ResistanceLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� ResistanceLine, dom(ResistanceLine)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(ResistancePointCount)}, s(1) < s(2) < ...< s(ResistancePointCount)
-'   ( s(ResistancePointCount)<= tE )- ������� �����
-' 3) ����� ������� ����� ResistancePointCount.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� SupportLine
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-  
-'1 ����������� ������� �������� �������
-    ResistancePointCount = 0
-    For t = 3 To tE - 1
- '      v = max{high(t-1), high(t+1)} < high(t)}
-        v = pP.Hgh(t - 1)
-        If v < pP.Hgh(t + 1) Then
-            v = pP.Hgh(t + 1)
-        End If
-        IsGoodPoint = pP.Hgh(t) > v
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) < pP.Hgh(t))
-        End If
-        
-        If IsGoodPoint Then       'alt.: v >= High(t + 1)
-            s(ResistancePointCount + 1) = t: ResistancePointCount = ResistancePointCount + 1
-        End If
-    Next t
-    
-loop_:
-    
-    If ResistancePointCount < 2 Then
-        GoTo done
-    End If
-
-' 2 ����������� ����� �������������
-    ResistanceLine(s(1)) = pP.Hgh(s(1))
-    For i = 2 To ResistancePointCount
-        ResistanceLine(s(i)) = pP.Hgh(s(i))
-        v = (pP.Hgh(s(i)) - pP.Hgh(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            ResistanceLine(t) = pP.Hgh(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(ResistancePointCount) < tE Then
-        v = (pP.Hgh(s(ResistancePointCount)) - pP.Hgh(s(ResistancePointCount - 1))) / (s(ResistancePointCount) - s(ResistancePointCount - 1))
-        For t = s(ResistancePointCount) + 1 To tE
-            ResistanceLine(t) = pP.Hgh(s(ResistancePointCount - 1)) + v * (t - s(ResistancePointCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To ResistancePointCount
-            If ResistanceLine(s(t) + 1) < pP.Cls(s(t) + 1) Then
-                ResistancePointCount = ResistancePointCount - 1
-                ' ������� �����
-                For i = t To ResistancePointCount
-                    s(i) = s(i + 1)
-                Next i
-                s(ResistancePointCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(ResistanceLine)
-                Rb = UBound(ResistanceLine)
-                Erase ResistanceLine
-                ReDim ResistanceLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-    
-done:
-End Sub
-
-Sub SuppLine(pP As TPriceData, tE As Integer, SupportPointsCount As Integer, _
-               SupportLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� SupportLine, dom(SupportLine)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(SupportPointsCount)}, s(1) < s(2) < ...< s(SupportPointsCount) -
-'    ������� �����
-' 3) ����� ������� ����� SupportPointsCount.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-    
-'1 ����������� ������� �������� �������
-     SupportPointsCount = 0
-    For t = 3 To tE - 1
-'       v = min{Low(t-1), Low(t+1)} > Low(t)
-        v = pP.Lw(t - 1)
-        If v > pP.Lw(t + 1) Then
-            v = pP.Lw(t + 1)
-        End If
-        
-        IsGoodPoint = pP.Lw(t) < v
-        
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) > pP.Lw(t))
-        End If
-        
-        If IsGoodPoint Then     'alt.: v >= High(t + 1)
-            s(SupportPointsCount + 1) = t: SupportPointsCount = SupportPointsCount + 1
-        End If
-    Next t
-
-loop_:
-    If SupportPointsCount < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� ���������
-    
-    SupportLine(s(1)) = pP.Lw(s(1))
-    For i = 2 To SupportPointsCount
-        SupportLine(s(i)) = pP.Lw(s(i))
-        v = (pP.Lw(s(i)) - pP.Lw(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            SupportLine(t) = pP.Lw(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(1) < tE Then
-        v = (pP.Lw(s(SupportPointsCount)) - pP.Lw(s(SupportPointsCount - 1))) / (s(SupportPointsCount) - s(SupportPointsCount - 1))
-        For t = s(SupportPointsCount) + 1 To tE
-            SupportLine(t) = pP.Lw(s(SupportPointsCount - 1)) + v * (t - s(SupportPointsCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To SupportPointsCount
-            If SupportLine(s(t) + 1) > pP.Cls(s(t) + 1) Then
-                SupportPointsCount = SupportPointsCount - 1
-                ' ������� �����
-                For i = t To SupportPointsCount
-                    s(i) = s(i + 1)
-                Next i
-                s(SupportPointsCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(SupportLine)
-                Rb = UBound(SupportLine)
-                Erase SupportLine
-                ReDim SupportLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-done:
-End Sub
-
-<<<<<<
-======================
-mChart
->>>>>>
-Attribute VB_Name = "mChart"
-Option Explicit
-
-Const CHART_NAME As String = "PriceChart"
-
-Sub Draw_Chart(SignalDefined As Boolean)
-
-    Dim n As Integer
-    Dim theChart As Chart
-    Dim ChartDataAria, szLastNumber As String
-    Dim MinYScale As Double
-    
-    
-    With ThisWorkbook
-' Checking data
-' Disable screen out
-        .Application.Cursor = xlWait
-        .Application.ScreenUpdating = False
-' Create series range
-        n = GetLinesCount(Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE))
-        szLastNumber = n + 1
-        If SignalDefined Then
-            ChartDataAria = "A2:A" & szLastNumber _
-                        & ",D2:D" & szLastNumber _
-                        & ",G2:G" & szLastNumber _
-                        & ",I2:K" & szLastNumber
-        Else
-            ChartDataAria = "A2:A" & szLastNumber _
-                        & ",D2:D" & szLastNumber _
-                        & ",G2:G" & szLastNumber _
-                        & ",I2:J" & szLastNumber
-        End If
-        MinYScale = GetMinValue(.Worksheets(RAW_DATA_SHEET).Range(ChartDataAria))
-' Find and delete old chart
-        .Worksheets(CHART_SHEET).Unprotect
-        Dim WindowWidth, WindowHeight As Integer
-        With .Worksheets(CHART_SHEET)
-            WindowWidth = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            WindowHeight = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-        
-        
-        With .Worksheets(CHART_SHEET).ChartObjects
-            .Delete
-            With .Add(5, 5, WindowWidth - 10, WindowHeight - 10)
-                .SendToBack
-                Set theChart = .Chart
-            End With
-' Create a chart
-        End With
-        With theChart
-            .ChartType = xlLine
-            .SetSourceData Source:=Sheets(RAW_DATA_SHEET).Range( _
-                    ChartDataAria), PlotBy:=xlColumns
-'                   .Location Where:=xlLocationAsObject, Name:=CHART_SHEET
-            .HasTitle = True
-            With .ChartTitle
-                .Text = ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE).Value
-                With .Font
-                    .Size = 8
-                    .Bold = True
-                End With
-            End With
-            .HasLegend = True
-            With .Legend
-                .Position = xlTop
-                With .Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            .HasDataTable = False
-            With .Axes(xlCategory)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                .TickLabels.Orientation = xlUpward
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .CrossesAt = 1
-                .TickLabelSpacing = 1
-                .TickMarkSpacing = 1
-                .AxisBetweenCategories = False
-                .ReversePlotOrder = False
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            With .Axes(xlValue)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .MinimumScale = MinYScale
-                .MaximumScaleIsAuto = True
-                .MinorUnitIsAuto = True
-                .MajorUnitIsAuto = True
-                .Crosses = xlCustom
-                .CrossesAt = MinYScale
-                .ReversePlotOrder = False
-                .ScaleType = xlLinear
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            .ChartTitle.Top = 5
-            .ChartTitle.Left = 5
-            With .Legend
-                .Top = 5
-                .Fill.OneColorGradient _
-                    Style:=msoGradientHorizontal, _
-                    Variant:=3, _
-                    Degree:=0.303913939116503
-                .Fill.Visible = True
-                .Fill.ForeColor.SchemeColor = 71
-            End With
-            .PlotArea.Left = 10
-            .PlotArea.Top = .Legend.Top + .Legend.Height + 5
-            .PlotArea.Width = .ChartArea.Width - 20
-            .PlotArea.Height = .ChartArea.Height - .PlotArea.Top
-            
-' Tune OPEN line
-            With .SeriesCollection(1)
-                .Border.LineStyle = xlNone
-                .MarkerBackgroundColorIndex = xlNone
-                .MarkerForegroundColorIndex = 1
-                .MarkerStyle = xlPlus
-                .Smooth = False
-                .MarkerSize = 9
-                .Shadow = False
-            End With
-' Tune CLOSE line
-            With .SeriesCollection(2)
-                .Border.ColorIndex = 10
-                .Border.Weight = xlMedium
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune RESISTANCE line
-            With .SeriesCollection(3)
-                .Border.ColorIndex = 3
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune SUUPORT line
-            With .SeriesCollection(4)
-                .Border.ColorIndex = 25
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-            If SignalDefined Then
-                With .SeriesCollection(5)
-                    .Border.ColorIndex = 6
-                    .Border.Weight = xlThin
-                    .Border.LineStyle = xlDot
-                End With
-            End If
-        End With
-        .Application.Cursor = xlDefault
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Protect userInterfaceOnly:=True
-        End With
-    End With
-End Sub
-
-Function GetMinValue(DataRange As Range) As Double
-    Dim Cell As Range
-    Dim MinValue, MaxValue, RangeValue, CorrectValue, Mult As Double
-    MinValue = MAX_PRICE_VALUE
-    MaxValue = MIN_PRICE_VALUE
-    For Each Cell In DataRange
-        If Not IsEmpty(Cell) And IsNumeric(Cell) Then
-            If Cell > MIN_PRICE_VALUE Then
-                If Cell < MinValue Then
-                    MinValue = Cell
-                End If
-                If Cell > MaxValue Then
-                    MaxValue = Cell
-                End If
-            End If
-        End If
-    Next
-    RangeValue = MaxValue - MinValue
-    If RangeValue < 0 Then
-        MinValue = 0
-    Else
-        CorrectValue = RangeValue / 4
-        Mult = MIN_PRICE_VALUE
-        While MinValue - Int(MinValue * Mult) / Mult > CorrectValue
-            Mult = Mult * 10
-        Wend
-        MinValue = Int(MinValue * Mult) / Mult
-    End If
-    GetMinValue = MinValue
-End Function
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{DF5FA93A-BD73-481A-846E-B5DA6D5395F7}{78BC8148-0EFA-432A-A856-1E6ADF571B7E}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-mWebQeury
->>>>>>
-Attribute VB_Name = "mWebQeury"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .Name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.Name = QryName Then
-            WebQuery.Delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.Name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-Attribute CreateCommandBar.VB_ProcData.VB_Invoke_Func = "R\n14"
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Contents"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 49
-                        .OnAction = "cmHelpContents"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mTool
->>>>>>
-Attribute VB_Name = "mTool"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub tool_delete_all_tables()
-    QryDelete ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range("A1")
-End Sub
-
-Sub tool_delete_all_charts(theSheet As Worksheet)
-    Dim theChart As Chart
-    For Each theChart In theSheet
-        theChart.Unprotect
-        theChart.Delete
-    Next
-End Sub
-
-Sub DateTimeTest()
-    Dim the_date
-    Dim the_time
-    the_date = DateValue(Now)
-    the_time = TimeValue(Now)
-End Sub
-
-
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{66FF4B59-65DE-49BF-B9F9-D0ECF0F365BE}{4D08F867-80C2-47C5-9CFA-069E31BEAB8C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-
-Private Sub App_WorkbookOpen(ByVal wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.count > 1 Then
-        wbname = wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-mDataCommands
->>>>>>
-Attribute VB_Name = "mDataCommands"
-Option Explicit
-
-Sub evFileOpen()
-    Dim fileToOpen As String
-    Dim wb As Workbook
-    Dim ticker As String
-    Dim Result As Integer
-
-    fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt, Data Files (*.csv), *.csv")
-    Set wb = ThisWorkbook
-    With wb
-        If fileToOpen <> "False" Then
-            If .Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = True Then
-                .Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = False
-            End If
-            .Worksheets(FORM_SHEET).Range(FILE_NAME) = fileToOpen
-            Result = UpdateHistoryFromFile(wb, fileToOpen)
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            
-            ClearResultTables
-            
-            Select Case Result
-                Case FUNCRES_FILE_OK
-                    .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = True
-                    If TDenmark_Calc Then
-                        With .Worksheets(RAW_DATA_SHEET)
-                            ticker = .Range("B1")
-                        End With
-                        With .Worksheets(FORM_SHEET)
-                            .Range("CALC_TICKER_NAME") = ticker
-                        End With
-                    End If
-                Case FUNCRES_FILE_VERY_SMALL
-                    .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_VERY_SMALL
-                    MsgBox MSG_FILE_VERY_SMALL, vbOKOnly, PROGRAM_NAME
-                Case FUNCRES_FILE_INVALID_FORMAT
-                    .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_INVALID_FORMAT
-                    MsgBox MSG_FILE_INVALID_FORMAT, vbOKOnly, PROGRAM_NAME
-                End Select
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-    End With 'wb
-End Sub
-
-Sub evSubmit_Click()
-    Dim ticker As String
-    Dim Period As String
-
-    Application.Cursor = xlWait
-    Dim wb As Workbook
-    Set wb = ThisWorkbook
-    With wb
-        With .Worksheets(VAR_SHEET)
-            ticker = .Range("DEN_SYMBOL")
-            Period = .Range("DEN_TIME")
-            If .Range("BOOL_DATA_READY") = False Or .Range("BOOL_LOAD_DATA") = True Then
-                .Range("BOOL_DATA_READY") = UpdateHistoryFromWeb(wb)
-            End If
-            .Range("BOOL_DEMARK_READY") = False
-        End With
-        If .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False Then
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            
-            ClearResultTables
-            
-            With .Worksheets(FORM_SHEET)
-                .Range("CALC_TICKER_NAME") = ticker & ", Period=" & Period
-                .Range("FILE_NAME") = ""
-                .Range(TABLE_COMMENT).Value = "������������ ������"
-            End With
-        Else
-            If TDenmark_Calc Then
-                With .Worksheets(FORM_SHEET)
-                    .Range("CALC_TICKER_NAME") = ticker & ", Period=" & Period
-                    .Range("FILE_NAME") = ""
-                End With
-            End If
-        End If
-    End With
-    Application.Cursor = xlDefault
-End Sub
-
-Sub evTicker_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SECNAME") = .Range("IDX_DEN_SYMBOL")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evSecName_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SYMBOL") = .Range("IDX_DEN_SECNAME")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evLastInterval_Change()
-    MsgBox "�� �������� � ���� ������"
-End Sub
-
-Sub evHistory_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_DATA_READY") = False
-    End With
-End Sub
-
-Sub evGroupChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        GroupIdx = .Range("IDX_DEN_LIST")
-        .Range("IDX_DEN_SYMBOL") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat.ListFillRange = NewCbxRange
-        NewRangeOffsetCol = NewRangeOffsetCol + 1
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat.ListFillRange = NewCbxRange
-    End With
-    evTicker_Change
-End Sub
-
-Sub evUpdateTickerList()
-    UpdateTickerList ThisWorkbook
-    evHistory_Change
-End Sub
-<<<<<<
-======================
-mGetFileData
->>>>>>
-Attribute VB_Name = "mGetFileData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Public Const MAX_LOAD_DATA_LINES As Integer = 16000
-
-Public Const MSG_FILE_VERY_SMALL As String = "� ����� ������������ ������"
-Public Const MSG_FILE_INVALID_FORMAT As String = "�������� ������ �����"
-
-Public Const FUNCRES_FILE_OK As Integer = 0
-Public Const FUNCRES_FILE_VERY_SMALL As Integer = -1
-Public Const FUNCRES_FILE_INVALID_FORMAT As Integer = -2
-
-Function UpdateHistoryFromFile(wb As Workbook, fileToOpen As String) As Integer
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    Dim SingleFileLine As String
-    Dim FileHandler As Integer
-    Dim i, j, row_idx As Integer
-    
-    UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = True
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            'Clear table include temp area
-            .Parent.Application.DisplayAlerts = False
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            
-            ' Reading data from file
-            FileHandler = FreeFile
-            row_idx = 0
-            Open fileToOpen For Input As #FileHandler
-            Do While Not EOF(FileHandler) And row_idx < MAX_LOAD_DATA_LINES
-                Line Input #FileHandler, SingleFileLine
-                .Range(PRICE_TABLE).Offset(row_idx, 0) = SingleFileLine
-                row_idx = row_idx + 1
-            Loop
-            Close #FileHandler
-            
-            ' Parsing data
-            DestRangeName = "=" & RAW_DATA_SHEET & "!$B$1:$B" & row_idx
-            ResultLength = row_idx
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-            .Parent.Application.DisplayAlerts = True
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            
-            If Not CheckFileFormat(RawData.Offset(-1, 0)) Then
-                UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-                Exit Function
-            End If
-            
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).Delete xlShiftUp
-            Else
-                UpdateHistoryFromFile = FUNCRES_FILE_VERY_SMALL
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).Delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromFile = FUNCRES_FILE_OK
-End Function
-
-Function CheckFileFormat(HeaderString As Range) As Boolean
-    With HeaderString
-        CheckFileFormat = _
-            .Offset(0, DATE_IDX) = "Date" And _
-            .Offset(0, TIME_IDX) = "Time" And _
-            .Offset(0, OPEN_IDX) = "Open" And _
-            .Offset(0, CLOSE_IDX) = "Close" And _
-            .Offset(0, LOW_IDX) = "Low" And _
-            .Offset(0, HIGH_IDX) = "High" And _
-            .Offset(0, VOLUME_IDX) = "Volume"
-    End With
-End Function
-<<<<<<
-Project Name : 'Denmark_method'
-Quirk - duff tag length======================
-MGetWebData
->>>>>>
-Attribute VB_Name = "MGetWebData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Const QueryDataName As String = "ExternalDenmarkData"
-
-Function UpdateHistoryFromWeb(wb As Workbook) As Boolean
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    UpdateHistoryFromWeb = False
-    QryPathStr = GetQryPath(wb)
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW")
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = IsNumeric(.Range("DEN_TIME"))
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table and temp area
-            With .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE))
-                .ClearContents
-                .NumberFormat = "General"
-            End With
-            
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-    
-'            .Parent.Application.DisplayAlerts = False
-    
-            If ResultLength < denWindow Then
-                Exit Function
-            End If
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                OtherChar:="|", _
-                FieldInfo:=Array( _
-                                Array(1, 9), _
-                                Array(2, 2), _
-                                Array(3, 1), _
-                                Array(4, 1), _
-                                Array(5, 1), _
-                                Array(6, 1), _
-                                Array(7, 1), _
-                                Array(8, 9), _
-                                Array(9, 9), _
-                                Array(10, 9), _
-                                Array(11, 9), _
-                                Array(12, 9))
-            
-            .Range(DestRangeName).EntireColumn.AutoFit
-            
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).NumberFormat = "General"
-            
-            Dim RawData As Range
-            Dim row_idx As Integer
-            
-            Set RawData = .Range(DestRangeName).Offset(0, 1)
-            RawData.Insert Shift:=xlToRight
-            
-            If Not IsIntraday Then
-                Set RawData = RawData.Offset(0, -1)
-                RawData.Value = "18:00"
-                RawData.Cells(1, 1).FormulaR1C1 = "TIME"
-                Set RawData = RawData.Offset(0, -1)
-            Else
-                Set RawData = RawData.Offset(0, -2)
-                RawData.TextToColumns _
-                    Destination:=RawData, _
-                    DataType:=xlDelimited, _
-                    TextQualifier:=xlDoubleQuote, _
-                    ConsecutiveDelimiter:=False, _
-                    Tab:=False, _
-                    Semicolon:=False, _
-                    Comma:=False, _
-                    Space:=True, _
-                    Other:=False, _
-                    OtherChar:="/", _
-                    FieldInfo:=Array( _
-                                    Array(1, 2), _
-                                    Array(2, 2))
-                RawData.Cells(1, 2).FormulaR1C1 = "TIME"
-            End If
-            
-'            Dim end_date As Date
-'            end_date = RawData.Cells(ResultLength, 1).FormulaR1C1
-
-' Delete unused space
-            
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + ResultLength, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            Dim i As Integer
-' Delete blank intervals
-            
-            Set RawData = .Range(RAW_DATA_RANGE).Offset(0, 0)
-            row_idx = 0
-            For i = 1 To ResultLength
-                ' skip virtual prices
-                If RawData.Offset(row_idx, CLOSE_IDX).Value > MIN_PRICE_VALUE Then
-                    row_idx = row_idx + 1
-                Else
-                    Set Location = .Range( _
-                            .Cells(row_idx + RAW_DATA_RANGE_ROW, DATE_IDX + RAW_DATA_RANGE_COL), _
-                            .Cells(row_idx + RAW_DATA_RANGE_ROW, PROJECT_IDX + RAW_DATA_RANGE_COL) _
-                    )
-                    Location.Delete xlShiftUp
-                End If
-            Next i
-            
-            ResultLength = GetLinesCount(.Range(RAW_DATA_RANGE))
-            
-            row_idx = ResultLength - 1
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).Delete xlShiftUp
-            Else
-                Exit Function
-            End If
-            
-            Dim TmpStr As String
-                        
-            row_idx = GetLinesCount(.Range(RAW_DATA_RANGE))
-            
-            Set RawData = .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx - 1, RAW_DATA_RANGE_COL + DATE_IDX) _
-                )
-            RawData.TextToColumns _
-                Destination:=.Range(RAW_DATA_RANGE).Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="-", _
-                FieldInfo:=Array( _
-                                Array(1, 2), _
-                                Array(2, 2), _
-                                Array(3, 2))
-            
-            Set Location = .Range(RAW_DATA_RANGE).Offset(0, -1)
-            
-            If IsIntraday Then
-                Set RawData = .Range( _
-                            .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + TIME_IDX), _
-                            .Cells(RAW_DATA_RANGE_ROW + row_idx - 1, RAW_DATA_RANGE_COL + TIME_IDX) _
-                    )
-                RawData.TextToColumns _
-                    Destination:=.Range(RAW_DATA_RANGE).Offset(0, TIME_STAMP_OFFSET), _
-                    DataType:=xlDelimited, _
-                    TextQualifier:=xlDoubleQuote, _
-                    ConsecutiveDelimiter:=False, _
-                    Tab:=False, _
-                    Semicolon:=False, _
-                    Comma:=False, _
-                    Space:=False, _
-                    Other:=True, _
-                    OtherChar:=":", _
-                    FieldInfo:=Array( _
-                                    Array(1, 2), _
-                                    Array(2, 2), _
-                                    Array(3, 2))
-                                    
-                
-                For i = 0 To row_idx - 1
-                    Location.Offset(i, 0) = "'" & _
-                            .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 1).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 2).Value _
-                            & "-" & .Range(RAW_DATA_RANGE).Offset(i, TIME_STAMP_OFFSET).Value _
-                            & ":" & .Range(RAW_DATA_RANGE).Offset(i, TIME_STAMP_OFFSET + 1).Value
-                Next
-            Else
-                For i = 0 To row_idx - 1
-                    Location.Offset(i, 0) = "'" & _
-                            .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 2).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 1).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET).Value
-                Next
-            End If
-            .Parent.Application.DisplayAlerts = True
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromWeb = True
-End Function
-
-Private Function GetQryPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    Dim IsIntradai As Boolean
-    Dim DayCount As Integer
-    Const DataFormat As String = "&data_format=BROWSER"
-    With wb.Worksheets(VAR_SHEET)
-        IsIntradai = IsNumeric(.Range("DEN_TIME"))
-        
-        If IsIntradai Then
-        
-            QryPathStr = "URL;http://export.rbc.ru/export/"
-            QryPathStr = QryPathStr & .Range("DEN_SOURCE")
-            QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-            QryPathStr = QryPathStr & "/?"
-            
-            QryPathStr = QryPathStr & "tickers=" & .Range("DEN_SYMBOL")
-            QryPathStr = QryPathStr & "&period=" & .Range("DEN_TIME")
-            QryPathStr = QryPathStr & "&virtual=PASS"
-            DayCount = .Range("DEN_HISTORY") * .Range("DEN_TIME") \ 420 + 1
-            QryPathStr = QryPathStr & "&lastdays=" & DayCount
-            QryPathStr = QryPathStr & "&separator=,"
-            QryPathStr = QryPathStr & DataFormat
-            QryPathStr = QryPathStr & "&header=1"
-        Else
-            QryPathStr = "URL;http://export.rbc.ru/cgi-bin/export/query_version/export.cgi?"
-            QryPathStr = QryPathStr & "&sourcename=" & .Range("DEN_SOURCE")
-            QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-            QryPathStr = QryPathStr & "&tickers=" & .Range("DEN_SYMBOL")
-            QryPathStr = QryPathStr & "&period=DAILY"
-            QryPathStr = QryPathStr & "&virtual=PASS"
-            QryPathStr = QryPathStr & "&lastdays=" & .Range("DEN_HISTORY") + 1
-            QryPathStr = QryPathStr & "&separator=,"
-            QryPathStr = QryPathStr & DataFormat
-            QryPathStr = QryPathStr & "&header=1"
-        End If
-    .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-End Function
-
-Sub UpdateTickerList(wb As Workbook)
-    Dim Idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    QryPathStr = GetListPath(wb)
-    With wb
-        With .Worksheets(VAR_SHEET)
-            Idx = .Range("IDX_DEN_LIST")
-            Set Location = .Range("TICKER_TABLES").Offset(0, (Idx - 1) * 2)
-             .Range("IDX_DEN_SYMBOL") = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-        
-            .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 0), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-        ' Setup Ticker List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        ' Setup Name List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Offset(0, 1).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        .Parent.Application.DisplayAlerts = True
-    End With
-End Sub
-
-Private Function GetListPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://export.rbc.ru/cgi-bin/export/tickers.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-        .Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            ThisWorkbook.Save
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(FORM_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-mReadWrite
->>>>>>
-Attribute VB_Name = "mReadWrite"
-Option Explicit
-
-Public Const GOOD_LINE_STATUS As String = "Ok"
-Public Const BAD_LINE_STATUS As String = "N/A"
-
-Function ReadPricesData(Location As Range, Hist As Integer, dt As Integer, _
-              pPriceData As TPriceData) As Integer
-    '������������� ���� TPriceData �� ������� ���� - 1
-    'k��������� �� ����� ��� hist ��������� �����
-    'aPoint - ������ �������
-    '������ ��� ������ ������� �������������� ������ (������)
-    Dim n, i As Integer
-    
-    '����������� ����� ����� ������� - n
-    n = GetLinesCount(Location)
-    ReadPricesData = n
-    If n < 9 Then             '���������� ������ !!!
-        GoTo done
-    End If
-    ' ����� ����� ���������� ()
-    If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-        Hist = (n - 3) \ dt + 1 '
-    End If
-    Dim t, s As Integer
-    For t = 0 To Hist - 1
-        s = n - t * dt - 1
-        pPriceData.D(Hist - t) = Location.Offset(s, DATE_IDX).Value
-        pPriceData.Tm(Hist - t) = Location.Offset(s, TIME_IDX).Value
-        pPriceData.Opn(Hist - t) = Location.Offset(s, OPEN_IDX).Value
-        pPriceData.Hgh(Hist - t) = Location.Offset(s, HIGH_IDX).Value
-        pPriceData.Lw(Hist - t) = Location.Offset(s, LOW_IDX).Value
-        pPriceData.Cls(Hist - t) = Location.Offset(s, CLOSE_IDX).Value
-        pPriceData.Vl(Hist - t) = Location.Offset(s, VOLUME_IDX).Value
-    Next t
-    ReadPricesData = t + 1
-done:
-End Function
-
-Sub ResultLinesOut(Location As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim n As Integer
-    
-    n = GetLinesCount(Location)
-    With Location
-        .Offset(-1, RESIST_IDX) = "Resistance"
-        .Offset(-1, SUPPORT_IDX) = "Support"
-        .Offset(-1, PROJECT_IDX) = "Project"
-    End With
-    Dim t, count, Idx, loc_idx As Integer
-    count = pPD.tC
-    For t = 0 To count - 1
-        Idx = count - t
-        loc_idx = n - t - 1
-        If pDen.ResistanceLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, RESIST_IDX).Value = pDen.ResistanceLine(Idx)
-        End If
-        If pDen.SupportLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, SUPPORT_IDX).Value = pDen.SupportLine(Idx)
-        End If
-        If Abs(pDen.SignalValue) > 1 Then
-            Location.Offset(loc_idx, PROJECT_IDX).Value = pDen.ProjectPrice
-        End If
-    Next t
-End Sub
-
-Sub Out_Table_1(TheRange As Range, pDen As TDenmark, LastIdx As Integer)
-    
-    
-    ' Col = 2 - �� ��������� !!!
-    ' Status - Col = 0
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(0, 0).Value = BAD_LINE_STATUS
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(1, 0).Value = BAD_LINE_STATUS
-    End If
-    ' -----------------------------------------
-    ' ���� �������� ����� ������������� � ��������� - Col = 1
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 1).Value = pDen.ResistanceAngle
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 1).Value = pDen.SupportAngle
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 1).Value = (pDen.ResistanceAngle + pDen.SupportAngle) / 2
-    End If
-    ' -----------------------------------------
-    ' ������� ���� ����� �������� �� ������� ������
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 2).Value = pDen.ResistanceLine(LastIdx)
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 2).Value = pDen.SupportLine(LastIdx)
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 2).Value = _
-            (pDen.ResistanceLine(LastIdx) + pDen.SupportLine(LastIdx)) / 2
-    End If
-    
-End Sub
-
-Sub Out_Table_2(TheRange As Range, TheComment As Range, pPD As TPriceData, pDen As TDenmark)
-    Const ColorIndexBUY = 5
-    Const ColorIndexSELL = 3
-    Const ColorIndexNOTHINK = 14
-    
-    Dim SignalValue_defined, allert_enable  As Boolean
-    Dim Message As String
-    SignalValue_defined = False
-    allert_enable = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_ALLERT_DLG")
-    Message = "������ �� ��������� ������ �� ���������������."
-    If pDen.SignalValue >= 2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "BUY"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexBUY
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue - 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "BUY Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & pDen.SignalValue - 1 & " ! "
-    End If
-    If pDen.SignalValue <= -2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "SELL"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexSELL
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue + 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "SELL Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(pDen.SignalValue + 1) & "!"
-    End If
-    With TheComment
-        .Value = Message
-        .Font.Bold = True
-        Dim color_idx As Integer
-        If SignalValue_defined Then
-            If pDen.SignalValue > 0 Then
-                .Font.ColorIndex = ColorIndexBUY
-            Else
-                .Font.ColorIndex = ColorIndexSELL
-            End If
-        Else
-            .Font.ColorIndex = ColorIndexNOTHINK
-        End If
-    End With
-    If allert_enable And SignalValue_defined Then
-        MsgBox _
-            Prompt:=Message, _
-            Title:=PROGRAM_NAME, _
-            Buttons:=vbOKOnly + vbInformation
-    End If
-End Sub
-
-Sub Out_Table_3(TheRange As Range, pDen As TDenmark)
-    Dim i As Integer
-    For i = 1 To 3
-        TheRange.Offset(i - 1, 0).Value = pDen.Qualificator(i)
-    Next i
-End Sub
-
-Sub Out_Table_4(TheRange As Range, pPD As TPriceData)
-    Dim LastIdx As Integer
-    LastIdx = pPD.tC
-    With TheRange
-        .Offset(0, 0).Value2 = "'" & pPD.D(LastIdx)
-        .Offset(0, 1).Value2 = "'" & pPD.Tm(LastIdx)
-        .Offset(0, 2) = pPD.Opn(LastIdx)
-        .Offset(0, 3) = pPD.Hgh(LastIdx)
-        .Offset(0, 4) = pPD.Lw(LastIdx)
-        .Offset(0, 5) = pPD.Cls(LastIdx)
-        .Offset(0, 6) = pPD.Cls(LastIdx) - pPD.Cls(LastIdx - 1)
-    End With
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Denmark method bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-    End With
-    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(wb As Workbook)
-    With wb
-        .Application.ScreenUpdating = False
-        
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(FORM_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-            .Select
-        End With
-        With .Worksheets(CHART_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-        End With
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(wb As Workbook)
-    With wb
-        .Unprotect
-        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Unprotect
-        End With
-        With .Worksheets(FORM_SHEET)
-            .Select
-            .Unprotect
-        End With
-        .Application.ScreenUpdating = True
-        
-    End With
-End Sub
-
-<<<<<<
-======================
-mTypes
->>>>>>
-Attribute VB_Name = "mTypes"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "����� �-�� ������� II"
-Public Const PROGRAM_VERSION As String = "version 4.3 Professional"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-Public Const ESTIMATION_DATE As Long = 20010615
-'Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "J27"
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const PRICE_TABLE As String = "B1"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-Public Const VAR_SHEET As String = "Var_s"
-
-Public Const CHART_SHEET As String = "Chart"
-
-Public Const MIN_PRICE_VALUE As Double = 0.000001
-Public Const MAX_PRICE_VALUE As Double = 1000000000
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const HIGH_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const CLOSE_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const RESIST_IDX As Integer = 7
-Public Const SUPPORT_IDX As Integer = 8
-Public Const PROJECT_IDX As Integer = 9
-
-Public Const DATE_STAMP_OFFSET = PROJECT_IDX + 1
-Public Const TIME_STAMP_OFFSET = PROJECT_IDX + 4
-Public Const DATE_TIME_STAMP_SIZE = 5
-
-Type TPriceData
-    D() As String      ' ����������� ����
-    Tm() As String     ' �����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Double     ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type TDenmark
-   ResistanceLine() As Double           'Resistance line
-   ResistancePoints() As Integer        'Resistance pivot points
-   ResistancePointCount As Integer      'The number of resistance pivot points
-   ResistanceAngle As Double            'Angle of Declination of ResistanceLine
-   
-   SupportLine() As Double              'Support line
-   SupportPoints() As Integer           'Support pivot points
-   SupportPointsCount As Integer        'The number of support pivot points
-   SupportAngle As Double               ' Angle of Declination of SupportLine
-   
-   SignalParameter     As Integer       ' parameter for SignalValue
-   SignalValue      As Integer          'SignalValue
-   
-   
-   Qualificator(1 To 3) As String       ' qualificators
- 
-   ProjectNumber As Integer             ' ����� ��������
-   ProjectPrice  As Double              ' �������� ����
-   
-End Type
-
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-Dim AppRunEnable As New cEnableRun
-
-
-Sub cmViewChart(Optional SwapPage As Boolean = True)
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_CHART_READY") = False
-        If .Range("BOOL_DEMARK_READY") <> True Then
-            If .Range("BOOL_AUTORECALC") = True Then
-                evSubmit_Click
-                If .Range("BOOL_DEMARK_READY") <> True Then
-                    Exit Sub
-                End If
-            Else
-                MsgBox _
-                    "������ �� ����� ���� ��������." & vbCrLf & "�������� ������ �� ����������.", _
-                    vbOKOnly + vbExclamation, _
-                    PROGRAM_NAME
-                Exit Sub
-            End If
-        End If
-    End With
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        With .Range("TABLE_1")
-            Dim test_lines As Boolean
-            test_lines = StrComp(.Cells(1, 1).Value, GOOD_LINE_STATUS)
-            test_lines = test_lines + StrComp(.Cells(2, 1).Value, GOOD_LINE_STATUS)
-            If test_lines <> 0 Then
-                MsgBox _
-                    Prompt:="������ �� ����� ���� ��������." & vbCrLf & "������� ����� �� ���������� .", _
-                    Title:=PROGRAM_NAME, _
-                    Buttons:=vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End With
-        Draw_Chart Not IsEmpty(.Range("TABLE_2").Cells(1, 1))
-    End With
-    With ThisWorkbook
-        .Worksheets(VAR_SHEET).Range("BOOL_CHART_READY") = True
-        If SwapPage Then
-            .Worksheets(CHART_SHEET).Select
-        End If
-    End With
-End Sub
-
-Sub cmViewForm()
-    With ThisWorkbook
-        .Worksheets(FORM_SHEET).Select
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Dim ResistanceLine
-    ResistanceLine = MsgBox( _
-        Prompt:="�� ������� ��������� ���������?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If ResistanceLine = vbYes Then
-       Application.Quit
-    End If
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Demark.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable wb:=ThisWorkbook
-    SetEnvironment wb:=ThisWorkbook
-    ProtectionEnable wb:=ThisWorkbook
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable wb:=ThisWorkbook
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=True
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmPrint()
-    If MsgBox( _
-            Prompt:="�� ������� ����������� ���������?", _
-            Buttons:=vbYesNo + vbQuestion, _
-            Title:=PROGRAM_NAME) = vbNo _
-    Then
-        Exit Sub
-    End If
-    Dim s_ticker, s_name, s_time As String
-    s_ticker = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME")
-    s_name = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_NAME")
-    s_time = Now
-    Application.ScreenUpdating = False
-    cmViewChart SwapPage:=False
-    Application.ScreenUpdating = False
-    With ThisWorkbook.Worksheets(FORM_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    With ThisWorkbook.Worksheets(CHART_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    Application.ScreenUpdating = False
-    ThisWorkbook.Worksheets(Array("MainForm", "Chart")).PrintOut Copies:=1, Collate:=True
-    cmViewForm
-End Sub
-<<<<<<
-======================
-mDemark
->>>>>>
-Attribute VB_Name = "mDemark"
-Option Explicit
-
-Public Const FORM_SHEET As String = "MainForm"
-
-'Form Ranges
-Public Const FILE_NAME As String = "FILE_NAME"
-Public Const TABLE_1 As String = "TABLE_1"
-Public Const TABLE_2 As String = "TABLE_2"
-Public Const TABLE_3 As String = "TABLE_3"
-Public Const TABLE_4 As String = "TABLE_4"
-Public Const TABLE_COMMENT As String = "TABLE_COMMENT"
-
-'�������� ��� ������ - �������� 1
-
-'*********************
-Dim PriceDataArray As TPriceData
-Dim DenmarkDataArray As TDenmark
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Sub ClearResultTables()
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        .Range(TABLE_1).ClearContents ' �������-1
-        .Range(TABLE_2).ClearContents ' �������-2
-        .Range(TABLE_3).ClearContents ' �������-3
-        .Range(TABLE_COMMENT).Value = "" ' ����������-3
-        .Range(TABLE_4).ClearContents ' �������-4
-    End With
-End Sub
-
-Function TDenmark_Calc() As Boolean
-    
-    Dim nWindow As Integer
-    Dim bPrevCloseFilter, bSuccCloseFilter As Boolean
-    
-    TDenmark_Calc = False
-    
-    mobjAppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-'1)    Read User data
-        With .Worksheets(VAR_SHEET)
-            DenmarkDataArray.ProjectNumber = .Range("DEN_PROECT").Value
-            DenmarkDataArray.SignalParameter = .Range("DEN_PARAM").Value
-            nWindow = .Range("DEN_WINDOW").Value
-            bPrevCloseFilter = .Range("BOOL_PREV_CLOSE").Value
-            bSuccCloseFilter = .Range("BOOL_SUCC_CLOSE").Value
-        End With
-
-'2)   Memory allocation
-        allocate_memory PriceDataArray, DenmarkDataArray, nWindow
-
-'3)   Read data
-        Dim TheRange As Range
-        Set TheRange = .Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE)
-        Dim LinesCount As Integer
-        LinesCount = ReadPricesData(Location:=TheRange, Hist:=PriceDataArray.tC, dt:=1, pPriceData:=PriceDataArray)
-        
-        'Init function result
-        TDenmark_Calc = LinesCount >= nWindow
-        
-        If LinesCount >= nWindow Then
-        
-'4)   Calculate metod TDenmarkDataArray
-            DetDenmark PriceDataArray, DenmarkDataArray, bPrevCloseFilter, bSuccCloseFilter
-            If Abs(DenmarkDataArray.SignalValue) > 1 Then  '������� ���������, ���� ���� ������
-                DetProj PriceDataArray, DenmarkDataArray
-            End If
-'5)   Write result
-            Application.ScreenUpdating = False
-    
-'6)    Clear interface tables
-            ClearResultTables
-            
-            ResultLinesOut Location:=TheRange.Offset(2, 0), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-            
-            With .Worksheets(FORM_SHEET)
-                Out_Table_1 TheRange:=.Range(TABLE_1).Cells(1, 1), pDen:=DenmarkDataArray, LastIdx:=PriceDataArray.tC
-                Out_Table_2 _
-                        TheRange:=.Range(TABLE_2).Cells(1, 1), _
-                        TheComment:=.Range("TABLE_COMMENT"), _
-                        pPD:=PriceDataArray, _
-                        pDen:=DenmarkDataArray
-                Out_Table_3 TheRange:=.Range(TABLE_3).Cells(1, 1), pDen:=DenmarkDataArray
-                Out_Table_4 TheRange:=.Range(TABLE_4).Cells(1, 1), pPD:=PriceDataArray
-                With .Range(TABLE_1)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_2)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_3)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_4)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-            End With
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = True
-        Else
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-'7)   Free unused memory
-        free_unused_memory PriceDataArray, DenmarkDataArray
-    End With
-End Function
-
-Sub allocate_memory(pPriceData As TPriceData, pDenmarkData As TDenmark, memsize As Integer)
-'  ������ ��� TDenmark
-    ReDim pDenmarkData.ResistanceLine(1 To memsize)
-    ReDim pDenmarkData.ResistancePoints(1 To memsize)
-    ReDim pDenmarkData.SupportLine(1 To memsize)
-    ReDim pDenmarkData.SupportPoints(1 To memsize)
-   
-' ������������� ������ �� �����
-    pPriceData.tC = memsize
-    ReDim pPriceData.D(1 To memsize)
-    ReDim pPriceData.Tm(1 To memsize)
-    ReDim pPriceData.Opn(1 To memsize)
-    ReDim pPriceData.Hgh(1 To memsize)
-    ReDim pPriceData.Lw(1 To memsize)
-    ReDim pPriceData.Cls(1 To memsize)
-    ReDim pPriceData.Vl(1 To memsize)
-
-End Sub
-
-Sub free_unused_memory(pP As TPriceData, pD As TDenmark)
-'   Free Prices
-    pP.tC = 0
-    Erase pP.D
-    Erase pP.Tm
-    Erase pP.Opn
-    Erase pP.Hgh
-    Erase pP.Lw
-    Erase pP.Cls
-    Erase pP.Vl
-    
-'Free TDenmark
-    Erase pD.ResistanceLine
-    Erase pD.ResistancePoints
-    Erase pD.SupportLine
-    Erase pD.SupportPoints
-End Sub
-
-
-'*****************************************
-Sub DetDenmark(pPriceData As TPriceData, pDenmarkData As TDenmark, ByVal ClosePrev2 As Boolean, ByVal CloseSucc1 As Boolean)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPriceData  - ����, ����������� ����� ������ �� ����� (����������)
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' pDenmarkData - �������� ������ �������� (������ ��������, SignalParameter - ���������):
-' ����� ResistanceLine,SupportLine �� �������, ������� �����, ������� � ������� ��� �������
-' SignalValue = 0 ������ �����������
-' SignalValue < 0 ������ ����������� ������ (������ �������)
-' SignalValue > 0 ������ ����������� ������ (������ �������)
-' ���� pDenmarkData.ResistancePointCount < 2, �� �������� ResistanceLine �� ������������
-' ���� pDenmarkData.SupportPointsCount < 2, �� �������� SupportLine �� ������������
-
-' ��������� ���������
-    Const QUALIFICATOR_DISABLE As String = "-"
-    Const QUALIFICATOR_ENABLE As String = "Signal"
-    
-    Dim UpQual(1 To 3) As String
-    Dim DownQual(1 To 3) As String
-    Dim UpSignal, DownSignal As Integer
-    Dim i As Integer
-    
-    pDenmarkData.SignalValue = 0
-    UpSignal = 0
-    DownSignal = 0
-    
-    For i = 1 To 3
-        pDenmarkData.Qualificator(i) = QUALIFICATOR_DISABLE
-        UpQual(i) = QUALIFICATOR_DISABLE
-        DownQual(i) = QUALIFICATOR_DISABLE
-    Next i
-    
-' ����������� ����� ��������� � �������������
-    ResLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.ResistancePointCount, _
-        pDenmarkData.ResistanceLine, _
-        pDenmarkData.ResistancePoints, _
-        ClosePrev2, _
-        CloseSucc1
-        
-    SuppLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.SupportPointsCount, _
-        pDenmarkData.SupportLine, _
-        pDenmarkData.SupportPoints, _
-        ClosePrev2, _
-        CloseSucc1
-
-        
-        
-    If pDenmarkData.ResistancePointCount >= 2 Then
-        pDenmarkData.ResistanceAngle = 57.29578 * _
-            Atn(pDenmarkData.ResistanceLine(pPriceData.tC) - _
-                pDenmarkData.ResistanceLine(pPriceData.tC - 1))
-    End If
-    If pDenmarkData.SupportPointsCount >= 2 Then
-        pDenmarkData.SupportAngle = 57.29578 * _
-            Atn(pDenmarkData.SupportLine(pPriceData.tC) - _
-                pDenmarkData.SupportLine(pPriceData.tC - 1))
-    End If
-
-' ������������ ������� ----------------------------------
-    Dim t As Integer
-' 1. ������ ����������� ������: ResistanceLine ��������� � ResistanceLine ������ *************
-    If pDenmarkData.ResistancePointCount >= 2 And pDenmarkData.ResistanceAngle < 0 Then
-'    ����������� ������� ������� �����
-        If pDenmarkData.ResistanceLine(pPriceData.tC) < pPriceData.Cls(pPriceData.tC) Then
-            UpSignal = 1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) > pDenmarkData.ResistanceLine(t) Then
-                    UpSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If UpSignal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) > pPriceData.Cls(pPriceData.tC - 1) Then
-                UpSignal = UpSignal + 1
-                UpQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: open > ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) > pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - demand value < ResistanceLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Lw(pPriceData.tC - 1) < pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-    End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: SupportLine ��������� � SupportLine ������
-    If pDenmarkData.SupportPointsCount >= 2 And pDenmarkData.SupportAngle > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-        If pPriceData.Cls(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-            DownSignal = -1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) < pDenmarkData.SupportLine(t) Then
-                    DownSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If DownSignal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) < pPriceData.Cls(pPriceData.tC - 1) Then
-                DownSignal = DownSignal - 1
-                DownQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: Open ���� ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - supply value(t-1) > SupportLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Hgh(pPriceData.tC - 1) > pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-'    ---------------------------------------------
-    End If
-'      ���������� ������������ ���������
-    If Abs(DownSignal) <> UpSignal Then
-        If Abs(DownSignal) > UpSignal Then
-            pDenmarkData.SignalValue = DownSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = DownQual(i)
-            Next i
-        Else
-            pDenmarkData.SignalValue = UpSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = UpQual(i)
-            Next i
-        End If
-    End If
-End Sub
-
-Sub DetProj(pPriceData As TPriceData, pDenmarkData As TDenmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-    Dim pM As Double, t As Integer, Tm As Integer, tL As Integer
-
-    If pDenmarkData.SignalValue >= 2 Then  ' ������ �������
-
-        tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount)     ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2 Then
-'           t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < ResistanceLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Lw(Tm) ' L(t-1) < ResistanceLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Lw(t) < pM And pPriceData.Lw(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Lw(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
-'               P1( tb) = ResistanceLine(tb) + ResistanceLine(t*) - L(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Lw(Tm)
-            Else
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If ' pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < ResistanceLine(t)}
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Cls(t) < pM And pPriceData.Cls(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue >= 2
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-    If pDenmarkData.SignalValue <= -2 Then
-        tL = pDenmarkData.SupportPoints(pDenmarkData.SupportPointsCount)  ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.SupportPointsCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber = 1 Or pDenmarkData.ProjectNumber = 2 Then
-'           t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > SupportLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Hgh(Tm) ' H(t-1) > SupportLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Hgh(t) > pM And pPriceData.Hgh(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Hgh(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
- '              P1( tb) = SupportLine(tb) + SupportLine(t*) - H(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Hgh(Tm)
-            Else
-'               P2( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  SupportLine(t)}
-'           P3( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pM < pPriceData.Cls(t) And pPriceData.Cls(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue <= -2
-End Sub
-
-Sub ResLine(pP As TPriceData, tE As Integer, ResistancePointCount As Integer, _
-            ResistanceLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� ResistanceLine, dom(ResistanceLine)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(ResistancePointCount)}, s(1) < s(2) < ...< s(ResistancePointCount)
-'   ( s(ResistancePointCount)<= tE )- ������� �����
-' 3) ����� ������� ����� ResistancePointCount.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� SupportLine
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-  
-'1 ����������� ������� �������� �������
-    ResistancePointCount = 0
-    For t = 3 To tE - 1
- '      v = max{high(t-1), high(t+1)} < high(t)}
-        v = pP.Hgh(t - 1)
-        If v < pP.Hgh(t + 1) Then
-            v = pP.Hgh(t + 1)
-        End If
-        IsGoodPoint = pP.Hgh(t) > v
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) < pP.Hgh(t))
-        End If
-        
-        If IsGoodPoint Then       'alt.: v >= High(t + 1)
-            s(ResistancePointCount + 1) = t: ResistancePointCount = ResistancePointCount + 1
-        End If
-    Next t
-    
-loop_:
-    
-    If ResistancePointCount < 2 Then
-        GoTo done
-    End If
-
-' 2 ����������� ����� �������������
-    ResistanceLine(s(1)) = pP.Hgh(s(1))
-    For i = 2 To ResistancePointCount
-        ResistanceLine(s(i)) = pP.Hgh(s(i))
-        v = (pP.Hgh(s(i)) - pP.Hgh(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            ResistanceLine(t) = pP.Hgh(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(ResistancePointCount) < tE Then
-        v = (pP.Hgh(s(ResistancePointCount)) - pP.Hgh(s(ResistancePointCount - 1))) / (s(ResistancePointCount) - s(ResistancePointCount - 1))
-        For t = s(ResistancePointCount) + 1 To tE
-            ResistanceLine(t) = pP.Hgh(s(ResistancePointCount - 1)) + v * (t - s(ResistancePointCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To ResistancePointCount
-            If ResistanceLine(s(t) + 1) < pP.Cls(s(t) + 1) Then
-                ResistancePointCount = ResistancePointCount - 1
-                ' ������� �����
-                For i = t To ResistancePointCount
-                    s(i) = s(i + 1)
-                Next i
-                s(ResistancePointCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(ResistanceLine)
-                Rb = UBound(ResistanceLine)
-                Erase ResistanceLine
-                ReDim ResistanceLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-    
-done:
-End Sub
-
-Sub SuppLine(pP As TPriceData, tE As Integer, SupportPointsCount As Integer, _
-               SupportLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� SupportLine, dom(SupportLine)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(SupportPointsCount)}, s(1) < s(2) < ...< s(SupportPointsCount) -
-'    ������� �����
-' 3) ����� ������� ����� SupportPointsCount.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-    
-'1 ����������� ������� �������� �������
-     SupportPointsCount = 0
-    For t = 3 To tE - 1
-'       v = min{Low(t-1), Low(t+1)} > Low(t)
-        v = pP.Lw(t - 1)
-        If v > pP.Lw(t + 1) Then
-            v = pP.Lw(t + 1)
-        End If
-        
-        IsGoodPoint = pP.Lw(t) < v
-        
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) > pP.Lw(t))
-        End If
-        
-        If IsGoodPoint Then     'alt.: v >= High(t + 1)
-            s(SupportPointsCount + 1) = t: SupportPointsCount = SupportPointsCount + 1
-        End If
-    Next t
-
-loop_:
-    If SupportPointsCount < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� ���������
-    
-    SupportLine(s(1)) = pP.Lw(s(1))
-    For i = 2 To SupportPointsCount
-        SupportLine(s(i)) = pP.Lw(s(i))
-        v = (pP.Lw(s(i)) - pP.Lw(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            SupportLine(t) = pP.Lw(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(1) < tE Then
-        v = (pP.Lw(s(SupportPointsCount)) - pP.Lw(s(SupportPointsCount - 1))) / (s(SupportPointsCount) - s(SupportPointsCount - 1))
-        For t = s(SupportPointsCount) + 1 To tE
-            SupportLine(t) = pP.Lw(s(SupportPointsCount - 1)) + v * (t - s(SupportPointsCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To SupportPointsCount
-            If SupportLine(s(t) + 1) > pP.Cls(s(t) + 1) Then
-                SupportPointsCount = SupportPointsCount - 1
-                ' ������� �����
-                For i = t To SupportPointsCount
-                    s(i) = s(i + 1)
-                Next i
-                s(SupportPointsCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(SupportLine)
-                Rb = UBound(SupportLine)
-                Erase SupportLine
-                ReDim SupportLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-done:
-End Sub
-
-<<<<<<
-======================
-mChart
->>>>>>
-Attribute VB_Name = "mChart"
-Option Explicit
-
-Const CHART_NAME As String = "PriceChart"
-
-Sub Draw_Chart(SignalDefined As Boolean)
-
-    Dim n As Integer
-    Dim theChart As Chart
-    Dim ChartDataAria, szLastNumber As String
-    Dim MinYScale As Double
-    
-    
-    With ThisWorkbook
-' Checking data
-' Disable screen out
-        .Application.Cursor = xlWait
-        .Application.ScreenUpdating = False
-' Create series range
-        n = GetLinesCount(Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE))
-        szLastNumber = n + 1
-        If SignalDefined Then
-            ChartDataAria = "A2:A" & szLastNumber _
-                        & ",D2:D" & szLastNumber _
-                        & ",G2:G" & szLastNumber _
-                        & ",I2:K" & szLastNumber
-        Else
-            ChartDataAria = "A2:A" & szLastNumber _
-                        & ",D2:D" & szLastNumber _
-                        & ",G2:G" & szLastNumber _
-                        & ",I2:J" & szLastNumber
-        End If
-        MinYScale = GetMinValue(.Worksheets(RAW_DATA_SHEET).Range(ChartDataAria))
-' Find and delete old chart
-        .Worksheets(CHART_SHEET).Unprotect
-        Dim WindowWidth, WindowHeight As Integer
-        With .Worksheets(CHART_SHEET)
-            WindowWidth = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            WindowHeight = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-        
-        
-        With .Worksheets(CHART_SHEET).ChartObjects
-            .Delete
-            With .Add(5, 5, WindowWidth - 10, WindowHeight - 10)
-                .SendToBack
-                Set theChart = .Chart
-            End With
-' Create a chart
-        End With
-        With theChart
-            .ChartType = xlLine
-            .SetSourceData Source:=Sheets(RAW_DATA_SHEET).Range( _
-                    ChartDataAria), PlotBy:=xlColumns
-'                   .Location Where:=xlLocationAsObject, Name:=CHART_SHEET
-            .HasTitle = True
-            With .ChartTitle
-                .Text = ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE).Value
-                With .Font
-                    .Size = 8
-                    .Bold = True
-                End With
-            End With
-            .HasLegend = True
-            With .Legend
-                .Position = xlTop
-                With .Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            .HasDataTable = False
-            With .Axes(xlCategory)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                .TickLabels.Orientation = xlUpward
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .CrossesAt = 1
-                .TickLabelSpacing = 1
-                .TickMarkSpacing = 1
-                .AxisBetweenCategories = False
-                .ReversePlotOrder = False
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            With .Axes(xlValue)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .MinimumScale = MinYScale
-                .MaximumScaleIsAuto = True
-                .MinorUnitIsAuto = True
-                .MajorUnitIsAuto = True
-                .Crosses = xlCustom
-                .CrossesAt = MinYScale
-                .ReversePlotOrder = False
-                .ScaleType = xlLinear
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            .ChartTitle.Top = 5
-            .ChartTitle.Left = 5
-            With .Legend
-                .Top = 5
-                .Fill.OneColorGradient _
-                    Style:=msoGradientHorizontal, _
-                    Variant:=3, _
-                    Degree:=0.303913939116503
-                .Fill.Visible = True
-                .Fill.ForeColor.SchemeColor = 71
-            End With
-            .PlotArea.Left = 10
-            .PlotArea.Top = .Legend.Top + .Legend.Height + 5
-            .PlotArea.Width = .ChartArea.Width - 20
-            .PlotArea.Height = .ChartArea.Height - .PlotArea.Top
-            
-' Tune OPEN line
-            With .SeriesCollection(1)
-                .Border.LineStyle = xlNone
-                .MarkerBackgroundColorIndex = xlNone
-                .MarkerForegroundColorIndex = 1
-                .MarkerStyle = xlPlus
-                .Smooth = False
-                .MarkerSize = 9
-                .Shadow = False
-            End With
-' Tune CLOSE line
-            With .SeriesCollection(2)
-                .Border.ColorIndex = 10
-                .Border.Weight = xlMedium
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune RESISTANCE line
-            With .SeriesCollection(3)
-                .Border.ColorIndex = 3
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune SUUPORT line
-            With .SeriesCollection(4)
-                .Border.ColorIndex = 25
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-            If SignalDefined Then
-                With .SeriesCollection(5)
-                    .Border.ColorIndex = 6
-                    .Border.Weight = xlThin
-                    .Border.LineStyle = xlDot
-                End With
-            End If
-        End With
-        .Application.Cursor = xlDefault
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Protect userInterfaceOnly:=True
-        End With
-    End With
-End Sub
-
-Function GetMinValue(DataRange As Range) As Double
-    Dim Cell As Range
-    Dim MinValue, MaxValue, RangeValue, CorrectValue, Mult As Double
-    MinValue = MAX_PRICE_VALUE
-    MaxValue = MIN_PRICE_VALUE
-    For Each Cell In DataRange
-        If Not IsEmpty(Cell) And IsNumeric(Cell) Then
-            If Cell > MIN_PRICE_VALUE Then
-                If Cell < MinValue Then
-                    MinValue = Cell
-                End If
-                If Cell > MaxValue Then
-                    MaxValue = Cell
-                End If
-            End If
-        End If
-    Next
-    RangeValue = MaxValue - MinValue
-    If RangeValue < 0 Then
-        MinValue = 0
-    Else
-        CorrectValue = RangeValue / 4
-        Mult = MIN_PRICE_VALUE
-        While MinValue - Int(MinValue * Mult) / Mult > CorrectValue
-            Mult = Mult * 10
-        Wend
-        MinValue = Int(MinValue * Mult) / Mult
-    End If
-    GetMinValue = MinValue
-End Function
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{029959BC-3504-4E6C-9EE2-769DD246AFF4}{24215672-3013-4BC6-A108-879F096F56E2}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-mWebQeury
->>>>>>
-Attribute VB_Name = "mWebQeury"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .Name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.Name = QryName Then
-            WebQuery.Delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.Name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-Attribute CreateCommandBar.VB_ProcData.VB_Invoke_Func = "R\n14"
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Contents"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 49
-                        .OnAction = "cmHelpContents"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mTool
->>>>>>
-Attribute VB_Name = "mTool"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub tool_delete_all_tables()
-    QryDelete ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range("A1")
-End Sub
-
-Sub tool_delete_all_charts(theSheet As Worksheet)
-    Dim theChart As Chart
-    For Each theChart In theSheet
-        theChart.Unprotect
-        theChart.Delete
-    Next
-End Sub
-
-Sub DateTimeTest()
-    Dim the_date
-    Dim the_time
-    the_date = DateValue(Now)
-    the_time = TimeValue(Now)
-End Sub
-
-
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{E22E292C-EF77-43F5-95D9-E9040592C04E}{0F23FD26-4F1A-4496-8297-1B6D21944441}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-
-
-Private Sub App_WorkbookOpen(ByVal wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.count > 1 Then
-        wbname = wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-mDataCommands
->>>>>>
-Attribute VB_Name = "mDataCommands"
-Option Explicit
-
-Sub evFileOpen()
-    Dim fileToOpen As String
-    Dim wb As Workbook
-    Dim Result As Integer
-
-    Set wb = ThisWorkbook
-    With wb
-        If .Worksheets(VAR_SHEET).Range("DEN_SOURCE") <> "file" Then
-            .Worksheets(VAR_SHEET).Range("IDX_DEN_LIST") = 6
-            evGroupChange
-        End If
-        If .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False Or .Worksheets(VAR_SHEET).Range("BOOL_LOAD_DATA") = True Then
-                fileToOpen = .Application.GetOpenFilename( _
-                                  "Text Files (*.txt), *.txt, Data Files (*.csv), *.csv")
-        End If
-          
-        If fileToOpen <> "False" Then
-            .Worksheets(FORM_SHEET).Range(FILE_NAME) = fileToOpen
-            Result = UpdateHistoryFromFile(wb, fileToOpen)
-            .Worksheets(VAR_SHEET).Range("LAST_FILE_QRY") = fileToOpen
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            
-            ClearResultTables
-        
-            Select Case Result
-            Case FUNCRES_FILE_OK
-                sbCalcFile
-            Case FUNCRES_FILE_VERY_SMALL
-                .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_VERY_SMALL
-                MsgBox MSG_FILE_VERY_SMALL, vbOKOnly, PROGRAM_NAME
-            Case FUNCRES_FILE_INVALID_FORMAT
-                .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_INVALID_FORMAT
-                MsgBox MSG_FILE_INVALID_FORMAT, vbOKOnly, PROGRAM_NAME
-            End Select
-'            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-    End With 'wb
-End Sub
-
-Sub sbCalcFile()
-    Dim wb As Workbook
-    Dim ticker As String
-    
-    Set wb = ThisWorkbook
-    With wb
-        ClearResultTables
-        
-        .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = True
-        If TDenmark_Calc Then
-            ticker = .Worksheets(RAW_DATA_SHEET).Range("B1")
-            Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = ticker
-        End If
-    End With 'wb
-End Sub
-
-Sub sbCalcWeb()
-    Dim wb As Workbook
-    Dim ticker As String
-    Dim Period As String
-    
-    Set wb = ThisWorkbook
-    With wb
-        ticker = .Worksheets(VAR_SHEET).Range("DEN_SYMBOL")
-        Period = .Worksheets(VAR_SHEET).Range("DEN_TIME")
-        If .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False Then
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            
-            ClearResultTables
-            
-            With .Worksheets(FORM_SHEET)
-                .Range("CALC_TICKER_NAME") = ticker & ", Period=" & Period
-                .Range("FILE_NAME") = ""
-                .Range(TABLE_COMMENT).Value = "������������ ������"
-            End With
-        Else
-            If TDenmark_Calc Then
-                With .Worksheets(FORM_SHEET)
-                    .Range("CALC_TICKER_NAME") = ticker & ", Period=" & Period
-                    .Range("FILE_NAME") = ""
-                End With
-            End If
-        End If
-    End With
-End Sub
-
-
-Sub evSubmit_Click()
-
-    Application.Cursor = xlWait
-    Dim wb As Workbook
-    Set wb = ThisWorkbook
-    With wb
-        With .Worksheets(VAR_SHEET)
-            If .Range("BOOL_DATA_READY") = False Or .Range("BOOL_LOAD_DATA") = True Then
-                If .Range("BOOL_FILE_DATA") = False Then
-                    .Range("BOOL_DATA_READY") = UpdateHistoryFromWeb(wb)
-                Else
-                    evFileOpen
-                    Application.Cursor = xlDefault
-                    Exit Sub
-                End If
-            End If
-            .Range("BOOL_DEMARK_READY") = False
-            If .Range("BOOL_FILE_DATA") = False Then
-                sbCalcWeb
-            Else
-                sbCalcFile
-            End If
-        End With
-    End With
-    Application.Cursor = xlDefault
-End Sub
-
-Sub evTicker_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SECNAME") = .Range("IDX_DEN_SYMBOL")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evSecName_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SYMBOL") = .Range("IDX_DEN_SECNAME")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evLastInterval_Change()
-    MsgBox "�� �������� � ���� ������"
-End Sub
-
-Sub evHistory_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_DATA_READY") = False
-    End With
-End Sub
-
-Sub evGroupChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        GroupIdx = .Range("IDX_DEN_LIST")
-        .Range("IDX_DEN_SYMBOL") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat.ListFillRange = NewCbxRange
-        NewRangeOffsetCol = NewRangeOffsetCol + 1
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat.ListFillRange = NewCbxRange
-    End With
-    evTicker_Change
-End Sub
-
-Sub evUpdateTickerList()
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_FILE_DATA") = False Then
-        UpdateTickerList ThisWorkbook
-        evHistory_Change
-    End If
-End Sub
-
-Sub evParamChange()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = True Then
-        evSubmit_Click
-    End If
-End Sub
-
-<<<<<<
-======================
-mGetFileData
->>>>>>
-Attribute VB_Name = "mGetFileData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Public Const MAX_LOAD_DATA_LINES As Integer = 16000
-
-Public Const MSG_FILE_VERY_SMALL As String = "� ����� ������������ ������"
-Public Const MSG_FILE_INVALID_FORMAT As String = "�������� ������ �����"
-
-Public Const FUNCRES_FILE_OK As Integer = 0
-Public Const FUNCRES_FILE_VERY_SMALL As Integer = -1
-Public Const FUNCRES_FILE_INVALID_FORMAT As Integer = -2
-
-Function UpdateHistoryFromFile(wb As Workbook, fileToOpen As String) As Integer
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    Dim SingleFileLine As String
-    Dim FileHandler As Integer
-    Dim i, j, row_idx As Integer
-    
-    UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = True
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            'Clear table include temp area
-            .Parent.Application.DisplayAlerts = False
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            
-            ' Reading data from file
-            FileHandler = FreeFile
-            row_idx = 0
-            Open fileToOpen For Input As #FileHandler
-            Do While Not EOF(FileHandler) And row_idx < MAX_LOAD_DATA_LINES
-                Line Input #FileHandler, SingleFileLine
-                .Range(PRICE_TABLE).Offset(row_idx, 0) = SingleFileLine
-                row_idx = row_idx + 1
-            Loop
-            Close #FileHandler
-            
-            ' Parsing data
-            DestRangeName = "=" & RAW_DATA_SHEET & "!$B$1:$B" & row_idx
-            ResultLength = row_idx
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-            .Parent.Application.DisplayAlerts = True
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            
-            If Not CheckFileFormat(RawData.Offset(-1, 0)) Then
-                UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-                Exit Function
-            End If
-            
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).Delete xlShiftUp
-            Else
-                UpdateHistoryFromFile = FUNCRES_FILE_VERY_SMALL
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).Delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromFile = FUNCRES_FILE_OK
-End Function
-
-Function CheckFileFormat(HeaderString As Range) As Boolean
-    With HeaderString
-        CheckFileFormat = _
-            .Offset(0, DATE_IDX) = "Date" And _
-            .Offset(0, TIME_IDX) = "Time" And _
-            .Offset(0, OPEN_IDX) = "Open" And _
-            .Offset(0, CLOSE_IDX) = "Close" And _
-            .Offset(0, LOW_IDX) = "Low" And _
-            .Offset(0, HIGH_IDX) = "High" And _
-            .Offset(0, VOLUME_IDX) = "Volume"
-    End With
-End Function
-<<<<<<
-Project Name : 'Denmark_method'
-Quirk - duff tag length======================
-MGetWebData
->>>>>>
-Attribute VB_Name = "MGetWebData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Const QueryDataName As String = "ExternalDenmarkData"
-
-Function UpdateHistoryFromWeb(wb As Workbook) As Boolean
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    UpdateHistoryFromWeb = False
-    QryPathStr = GetQryPath(wb)
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW")
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = IsNumeric(.Range("DEN_TIME"))
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table and temp area
-            With .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE))
-                .ClearContents
-                .NumberFormat = "General"
-            End With
-            
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-    
-'            .Parent.Application.DisplayAlerts = False
-    
-            If ResultLength < denWindow Then
-                Exit Function
-            End If
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                OtherChar:="|", _
-                FieldInfo:=Array( _
-                                Array(1, xlSkipColumn), _
-                                Array(2, xlTextFormat), _
-                                Array(3, xlGeneralFormat), _
-                                Array(4, xlGeneralFormat), _
-                                Array(5, xlGeneralFormat), _
-                                Array(6, xlGeneralFormat), _
-                                Array(7, xlGeneralFormat), _
-                                Array(8, xlSkipColumn), _
-                                Array(9, xlSkipColumn), _
-                                Array(10, xlSkipColumn), _
-                                Array(11, xlSkipColumn), _
-                                Array(12, xlSkipColumn))
-            
-            .Range(DestRangeName).EntireColumn.AutoFit
-            
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).NumberFormat = "General"
-            
-            Dim RawData As Range
-            Dim row_idx As Integer
-            
-            Set RawData = .Range(DestRangeName).Offset(0, 1)
-            RawData.Insert Shift:=xlToRight
-            
-            If Not IsIntraday Then
-                Set RawData = RawData.Offset(0, -1)
-                RawData.Value = "18:00"
-                RawData.Cells(1, 1).FormulaR1C1 = "TIME"
-                Set RawData = RawData.Offset(0, -1)
-            Else
-                Set RawData = RawData.Offset(0, -2)
-                RawData.TextToColumns _
-                    Destination:=RawData, _
-                    DataType:=xlDelimited, _
-                    TextQualifier:=xlDoubleQuote, _
-                    ConsecutiveDelimiter:=False, _
-                    Tab:=False, _
-                    Semicolon:=False, _
-                    Comma:=False, _
-                    Space:=True, _
-                    Other:=False, _
-                    OtherChar:="/", _
-                    FieldInfo:=Array( _
-                                    Array(1, xlTextFormat), _
-                                    Array(2, xlTextFormat))
-                RawData.Cells(1, 2).FormulaR1C1 = "TIME"
-            End If
-            
-'            Dim end_date As Date
-'            end_date = RawData.Cells(ResultLength, 1).FormulaR1C1
-
-' Delete unused space
-            
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + ResultLength, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            Dim i As Integer
-' Delete blank intervals
-            
-            Set RawData = .Range(RAW_DATA_RANGE).Offset(0, 0)
-            row_idx = 0
-            For i = 1 To ResultLength
-                ' skip virtual prices
-                If RawData.Offset(row_idx, CLOSE_IDX).Value > MIN_PRICE_VALUE Then
-                    row_idx = row_idx + 1
-                Else
-                    Set Location = .Range( _
-                            .Cells(row_idx + RAW_DATA_RANGE_ROW, DATE_IDX + RAW_DATA_RANGE_COL), _
-                            .Cells(row_idx + RAW_DATA_RANGE_ROW, PROJECT_IDX + RAW_DATA_RANGE_COL) _
-                    )
-                    Location.Delete xlShiftUp
-                End If
-            Next i
-            
-            ResultLength = GetLinesCount(.Range(RAW_DATA_RANGE))
-            
-            row_idx = ResultLength - 1
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).Delete xlShiftUp
-            Else
-                Exit Function
-            End If
-            
-            Dim TmpStr As String
-                        
-            row_idx = GetLinesCount(.Range(RAW_DATA_RANGE))
-            
-            Set RawData = .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx - 1, RAW_DATA_RANGE_COL + DATE_IDX) _
-                )
-            RawData.TextToColumns _
-                Destination:=.Range(RAW_DATA_RANGE).Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="-", _
-                FieldInfo:=Array( _
-                                Array(1, xlTextFormat), _
-                                Array(2, xlTextFormat), _
-                                Array(3, xlTextFormat))
-            
-            Set Location = .Range(RAW_DATA_RANGE).Offset(0, -1)
-            
-            If IsIntraday Then
-                Set RawData = .Range( _
-                            .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + TIME_IDX), _
-                            .Cells(RAW_DATA_RANGE_ROW + row_idx - 1, RAW_DATA_RANGE_COL + TIME_IDX) _
-                    )
-                RawData.TextToColumns _
-                    Destination:=.Range(RAW_DATA_RANGE).Offset(0, TIME_STAMP_OFFSET), _
-                    DataType:=xlDelimited, _
-                    TextQualifier:=xlDoubleQuote, _
-                    ConsecutiveDelimiter:=False, _
-                    Tab:=False, _
-                    Semicolon:=False, _
-                    Comma:=False, _
-                    Space:=False, _
-                    Other:=True, _
-                    OtherChar:=":", _
-                    FieldInfo:=Array( _
-                                    Array(1, xlTextFormat), _
-                                    Array(2, xlTextFormat), _
-                                    Array(3, xlTextFormat))
-                                    
-                
-                For i = 0 To row_idx - 1
-                    Location.Offset(i, 0) = "'" & _
-                            .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 1).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 2).Value _
-                            & "-" & .Range(RAW_DATA_RANGE).Offset(i, TIME_STAMP_OFFSET).Value _
-                            & ":" & .Range(RAW_DATA_RANGE).Offset(i, TIME_STAMP_OFFSET + 1).Value
-                Next
-            Else
-                For i = 0 To row_idx - 1
-                    Location.Offset(i, 0) = "'" & _
-                            .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 2).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 1).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET).Value
-                Next
-            End If
-            .Parent.Application.DisplayAlerts = True
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromWeb = True
-End Function
-
-Private Function GetQryPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    Dim IsIntradai As Boolean
-    Dim DayCount As Integer
-    Const DataFormat As String = "&data_format=BROWSER"
-    With wb.Worksheets(VAR_SHEET)
-        IsIntradai = IsNumeric(.Range("DEN_TIME"))
-        
-        If IsIntradai Then
-        
-            QryPathStr = "URL;http://export.rbc.ru/export/"
-            QryPathStr = QryPathStr & .Range("DEN_SOURCE")
-            QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-            QryPathStr = QryPathStr & "/?"
-            
-            QryPathStr = QryPathStr & "tickers=" & .Range("DEN_SYMBOL")
-            QryPathStr = QryPathStr & "&period=" & .Range("DEN_TIME")
-            QryPathStr = QryPathStr & "&virtual=PASS"
-            DayCount = .Range("DEN_HISTORY") * .Range("DEN_TIME") \ 420 + 1
-            QryPathStr = QryPathStr & "&lastdays=" & DayCount
-            QryPathStr = QryPathStr & "&separator=,"
-            QryPathStr = QryPathStr & DataFormat
-            QryPathStr = QryPathStr & "&header=1"
-        Else
-            QryPathStr = "URL;http://export.rbc.ru/cgi-bin/export/query_version/export.cgi?"
-            QryPathStr = QryPathStr & "&sourcename=" & .Range("DEN_SOURCE")
-            QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-            QryPathStr = QryPathStr & "&tickers=" & .Range("DEN_SYMBOL")
-            QryPathStr = QryPathStr & "&period=DAILY"
-            QryPathStr = QryPathStr & "&virtual=PASS"
-            QryPathStr = QryPathStr & "&lastdays=" & .Range("DEN_HISTORY") + 1
-            QryPathStr = QryPathStr & "&separator=,"
-            QryPathStr = QryPathStr & DataFormat
-            QryPathStr = QryPathStr & "&header=1"
-        End If
-    .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-End Function
-
-Sub UpdateTickerList(wb As Workbook)
-    Dim Idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    QryPathStr = GetListPath(wb)
-    With wb
-        With .Worksheets(VAR_SHEET)
-            Idx = .Range("IDX_DEN_LIST")
-            Set Location = .Range("TICKER_TABLES").Offset(0, (Idx - 1) * 2)
-             .Range("IDX_DEN_SYMBOL") = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-        
-            .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 0), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-        ' Setup Ticker List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        ' Setup Name List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Offset(0, 1).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        .Parent.Application.DisplayAlerts = True
-    End With
-End Sub
-
-Private Function GetListPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://export.rbc.ru/cgi-bin/export/tickers.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-        .Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            ThisWorkbook.Save
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(FORM_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mReadWrite
->>>>>>
-Attribute VB_Name = "mReadWrite"
-Option Explicit
-
-Public Const GOOD_LINE_STATUS As String = "Ok"
-Public Const BAD_LINE_STATUS As String = "N/A"
-
-Function ReadPricesData(Location As Range, Hist As Integer, dt As Integer, _
-              pPriceData As TPriceData) As Integer
-    '������������� ���� TPriceData �� ������� ���� - 1
-    'k��������� �� ����� ��� hist ��������� �����
-    'aPoint - ������ �������
-    '������ ��� ������ ������� �������������� ������ (������)
-    Dim n, i As Integer
-    
-    '����������� ����� ����� ������� - n
-    n = GetLinesCount(Location)
-    ReadPricesData = n
-    If n < 9 Then             '���������� ������ !!!
-        GoTo done
-    End If
-    ' ����� ����� ���������� ()
-    If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-        Hist = (n - 3) \ dt + 1 '
-    End If
-    Dim t, s As Integer
-    For t = 0 To Hist - 1
-        s = n - t * dt - 1
-        pPriceData.D(Hist - t) = Location.Offset(s, DATE_IDX).Value
-        pPriceData.Tm(Hist - t) = Location.Offset(s, TIME_IDX).Value
-        pPriceData.Opn(Hist - t) = Location.Offset(s, OPEN_IDX).Value
-        pPriceData.Hgh(Hist - t) = Location.Offset(s, HIGH_IDX).Value
-        pPriceData.Lw(Hist - t) = Location.Offset(s, LOW_IDX).Value
-        pPriceData.Cls(Hist - t) = Location.Offset(s, CLOSE_IDX).Value
-        pPriceData.Vl(Hist - t) = Location.Offset(s, VOLUME_IDX).Value
-    Next t
-    ReadPricesData = t + 1
-done:
-End Function
-
-Sub ResultLinesOut(Location As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim n As Integer
-    
-    n = GetLinesCount(Location)
-    With Location
-        .Offset(-1, RESIST_IDX) = "Resistance"
-        .Offset(-1, SUPPORT_IDX) = "Support"
-        .Offset(-1, PROJECT_IDX) = "Project"
-    End With
-    Dim t, count, Idx, loc_idx As Integer
-    count = pPD.tC
-    For t = 0 To count - 1
-        Idx = count - t
-        loc_idx = n - t - 1
-        If pDen.ResistanceLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, RESIST_IDX).Value = pDen.ResistanceLine(Idx)
-        End If
-        If pDen.SupportLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, SUPPORT_IDX).Value = pDen.SupportLine(Idx)
-        End If
-        If Abs(pDen.SignalValue) > 1 Then
-            Location.Offset(loc_idx, PROJECT_IDX).Value = pDen.ProjectPrice
-        End If
-    Next t
-End Sub
-
-Sub Out_Table_1(TheRange As Range, pDen As TDenmark, LastIdx As Integer)
-    
-    
-    ' Col = 2 - �� ��������� !!!
-    ' Status - Col = 0
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(0, 0).Value = BAD_LINE_STATUS
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(1, 0).Value = BAD_LINE_STATUS
-    End If
-    ' -----------------------------------------
-    ' ���� �������� ����� ������������� � ��������� - Col = 1
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 1).Value = pDen.ResistanceAngle
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 1).Value = pDen.SupportAngle
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 1).Value = (pDen.ResistanceAngle + pDen.SupportAngle) / 2
-    End If
-    ' -----------------------------------------
-    ' ������� ���� ����� �������� �� ������� ������
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 2).Value = pDen.ResistanceLine(LastIdx)
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 2).Value = pDen.SupportLine(LastIdx)
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 2).Value = _
-            (pDen.ResistanceLine(LastIdx) + pDen.SupportLine(LastIdx)) / 2
-    End If
-    
-End Sub
-
-Sub Out_Table_2(TheRange As Range, TheComment As Range, pPD As TPriceData, pDen As TDenmark)
-    Const ColorIndexBUY = 5
-    Const ColorIndexSELL = 3
-    Const ColorIndexNOTHINK = 14
-    
-    Dim SignalValue_defined, allert_enable  As Boolean
-    Dim Message As String
-    SignalValue_defined = False
-    allert_enable = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_ALLERT_DLG")
-    Message = "������ �� ��������� ������ �� ���������������."
-    If pDen.SignalValue >= 2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "BUY"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexBUY
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue - 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "BUY Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & pDen.SignalValue - 1 & " ! "
-    End If
-    If pDen.SignalValue <= -2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "SELL"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexSELL
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue + 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "SELL Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(pDen.SignalValue + 1) & "!"
-    End If
-    With TheComment
-        .Value = Message
-        .Font.Bold = True
-        Dim color_idx As Integer
-        If SignalValue_defined Then
-            If pDen.SignalValue > 0 Then
-                .Font.ColorIndex = ColorIndexBUY
-            Else
-                .Font.ColorIndex = ColorIndexSELL
-            End If
-        Else
-            .Font.ColorIndex = ColorIndexNOTHINK
-        End If
-    End With
-    If allert_enable And SignalValue_defined Then
-        MsgBox _
-            Prompt:=Message, _
-            Title:=PROGRAM_NAME, _
-            Buttons:=vbOKOnly + vbInformation
-    End If
-End Sub
-
-Sub Out_Table_3(TheRange As Range, pDen As TDenmark)
-    Dim i As Integer
-    For i = 1 To 3
-        TheRange.Offset(i - 1, 0).Value = pDen.Qualificator(i)
-    Next i
-End Sub
-
-Sub Out_Table_4(TheRange As Range, pPD As TPriceData)
-    Dim LastIdx As Integer
-    LastIdx = pPD.tC
-    With TheRange
-        .Offset(0, 0).Value2 = "'" & pPD.D(LastIdx)
-        .Offset(0, 1).Value2 = "'" & pPD.Tm(LastIdx)
-        .Offset(0, 2) = pPD.Opn(LastIdx)
-        .Offset(0, 3) = pPD.Hgh(LastIdx)
-        .Offset(0, 4) = pPD.Lw(LastIdx)
-        .Offset(0, 5) = pPD.Cls(LastIdx)
-        .Offset(0, 6) = pPD.Cls(LastIdx) - pPD.Cls(LastIdx - 1)
-    End With
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Denmark method bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-    End With
-    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(wb As Workbook)
-    With wb
-        .Application.ScreenUpdating = False
-        
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(FORM_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-            .Select
-        End With
-        With .Worksheets(CHART_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-        End With
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(wb As Workbook)
-    With wb
-        .Unprotect
-        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Unprotect
-        End With
-        With .Worksheets(FORM_SHEET)
-            .Select
-            .Unprotect
-        End With
-        .Application.ScreenUpdating = True
-        
-    End With
-End Sub
-
-<<<<<<
-======================
-mTypes
->>>>>>
-Attribute VB_Name = "mTypes"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "����� �-�� ������� II"
-Public Const PROGRAM_VERSION As String = "version 4.1 Professional"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-Public Const ESTIMATION_DATE As Long = 20010915
-'Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "J27"
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const PRICE_TABLE As String = "B1"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-Public Const VAR_SHEET As String = "Var_s"
-
-Public Const CHART_SHEET As String = "Chart"
-
-Public Const MIN_PRICE_VALUE As Double = 0.000001
-Public Const MAX_PRICE_VALUE As Double = 1000000000
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const HIGH_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const CLOSE_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const RESIST_IDX As Integer = 7
-Public Const SUPPORT_IDX As Integer = 8
-Public Const PROJECT_IDX As Integer = 9
-
-Public Const DATE_STAMP_OFFSET = PROJECT_IDX + 1
-Public Const TIME_STAMP_OFFSET = PROJECT_IDX + 4
-Public Const DATE_TIME_STAMP_SIZE = 5
-
-Type TPriceData
-    D() As String      ' ����������� ����
-    Tm() As String     ' �����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Double     ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type TDenmark
-   ResistanceLine() As Double           'Resistance line
-   ResistancePoints() As Integer        'Resistance pivot points
-   ResistancePointCount As Integer      'The number of resistance pivot points
-   ResistanceAngle As Double            'Angle of Declination of ResistanceLine
-   
-   SupportLine() As Double              'Support line
-   SupportPoints() As Integer           'Support pivot points
-   SupportPointsCount As Integer        'The number of support pivot points
-   SupportAngle As Double               ' Angle of Declination of SupportLine
-   
-   SignalParameter     As Integer       ' parameter for SignalValue
-   SignalValue      As Integer          'SignalValue
-   
-   
-   Qualificator(1 To 3) As String       ' qualificators
- 
-   ProjectNumber As Integer             ' ����� ��������
-   ProjectPrice  As Double              ' �������� ����
-   
-End Type
-
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-Dim AppRunEnable As New cEnableRun
-
-Sub evParamChange()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = True Then
-        evSubmit_Click
-    End If
-End Sub
-
-Sub cmViewChart(Optional SwapPage As Boolean = True)
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_CHART_READY") = False
-        If .Range("BOOL_DEMARK_READY") <> True Then
-            If .Range("BOOL_AUTORECALC") = True Then
-                evSubmit_Click
-                If .Range("BOOL_DEMARK_READY") <> True Then
-                    Exit Sub
-                End If
-            Else
-                MsgBox _
-                    "������ �� ����� ���� ��������." & vbCrLf & "�������� ������ �� ����������.", _
-                    vbOKOnly + vbExclamation, _
-                    PROGRAM_NAME
-                Exit Sub
-            End If
-        End If
-    End With
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        With .Range("TABLE_1")
-            Dim test_lines As Boolean
-            test_lines = StrComp(.Cells(1, 1).Value, GOOD_LINE_STATUS)
-            test_lines = test_lines + StrComp(.Cells(2, 1).Value, GOOD_LINE_STATUS)
-            If test_lines <> 0 Then
-                MsgBox _
-                    Prompt:="������ �� ����� ���� ��������." & vbCrLf & "������� ����� �� ���������� .", _
-                    Title:=PROGRAM_NAME, _
-                    Buttons:=vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End With
-        Draw_Chart Not IsEmpty(.Range("TABLE_2").Cells(1, 1))
-    End With
-    With ThisWorkbook
-        .Worksheets(VAR_SHEET).Range("BOOL_CHART_READY") = True
-        If SwapPage Then
-            .Worksheets(CHART_SHEET).Select
-        End If
-    End With
-End Sub
-
-Sub cmViewForm()
-    With ThisWorkbook
-        .Worksheets(FORM_SHEET).Select
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Dim ResistanceLine
-    ResistanceLine = MsgBox( _
-        Prompt:="�� ������� ��������� ���������?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If ResistanceLine = vbYes Then
-       Application.Quit
-    End If
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Demark.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable wb:=ThisWorkbook
-    SetEnvironment wb:=ThisWorkbook
-    ProtectionEnable wb:=ThisWorkbook
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable wb:=ThisWorkbook
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=True
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmPrint()
-    If MsgBox( _
-            Prompt:="�� ������� ����������� ���������?", _
-            Buttons:=vbYesNo + vbQuestion, _
-            Title:=PROGRAM_NAME) = vbNo _
-    Then
-        Exit Sub
-    End If
-    Dim s_ticker, s_name, s_time As String
-    s_ticker = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME")
-    s_name = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_NAME")
-    s_time = Now
-    Application.ScreenUpdating = False
-    cmViewChart SwapPage:=False
-    Application.ScreenUpdating = False
-    With ThisWorkbook.Worksheets(FORM_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    With ThisWorkbook.Worksheets(CHART_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    Application.ScreenUpdating = False
-    ThisWorkbook.Worksheets(Array("MainForm", "Chart")).PrintOut Copies:=1, Collate:=True
-    cmViewForm
-End Sub
-<<<<<<
-======================
-mDemark
->>>>>>
-Attribute VB_Name = "mDemark"
-Option Explicit
-
-Public Const FORM_SHEET As String = "MainForm"
-
-'Form Ranges
-Public Const FILE_NAME As String = "FILE_NAME"
-Public Const TABLE_1 As String = "TABLE_1"
-Public Const TABLE_2 As String = "TABLE_2"
-Public Const TABLE_3 As String = "TABLE_3"
-Public Const TABLE_4 As String = "TABLE_4"
-Public Const TABLE_COMMENT As String = "TABLE_COMMENT"
-
-'�������� ��� ������ - �������� 1
-
-'*********************
-Dim PriceDataArray As TPriceData
-Dim DenmarkDataArray As TDenmark
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Sub ClearResultTables()
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        .Range(TABLE_1).ClearContents ' �������-1
-        .Range(TABLE_2).ClearContents ' �������-2
-        .Range(TABLE_3).ClearContents ' �������-3
-        .Range(TABLE_COMMENT).Value = "" ' ����������-3
-        .Range(TABLE_4).ClearContents ' �������-4
-    End With
-End Sub
-
-Function TDenmark_Calc() As Boolean
-    
-    Dim nWindow As Integer
-    Dim bPrevCloseFilter, bSuccCloseFilter As Boolean
-    
-    TDenmark_Calc = False
-    
-    mobjAppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-'1)    Read User data
-        With .Worksheets(VAR_SHEET)
-            DenmarkDataArray.ProjectNumber = .Range("DEN_PROECT").Value
-            DenmarkDataArray.SignalParameter = .Range("DEN_PARAM").Value
-            nWindow = .Range("DEN_WINDOW").Value
-            bPrevCloseFilter = .Range("BOOL_PREV_CLOSE").Value
-            bSuccCloseFilter = .Range("BOOL_SUCC_CLOSE").Value
-        End With
-
-'2)   Memory allocation
-        allocate_memory PriceDataArray, DenmarkDataArray, nWindow
-
-'3)   Read data
-        Dim TheRange As Range
-        Set TheRange = .Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE)
-        Dim LinesCount As Integer
-        LinesCount = ReadPricesData(Location:=TheRange, Hist:=PriceDataArray.tC, dt:=1, pPriceData:=PriceDataArray)
-        
-        'Init function result
-        TDenmark_Calc = LinesCount >= nWindow
-        
-        If LinesCount >= nWindow Then
-        
-'4)   Calculate metod TDenmarkDataArray
-            DetDenmark PriceDataArray, DenmarkDataArray, bPrevCloseFilter, bSuccCloseFilter
-            If Abs(DenmarkDataArray.SignalValue) > 1 Then  '������� ���������, ���� ���� ������
-                DetProj PriceDataArray, DenmarkDataArray
-            End If
-'5)   Write result
-            Application.ScreenUpdating = False
-    
-'6)    Clear interface tables
-            ClearResultTables
-            
-            ResultLinesOut Location:=TheRange.Offset(2, 0), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-            
-            With .Worksheets(FORM_SHEET)
-                Out_Table_1 TheRange:=.Range(TABLE_1).Cells(1, 1), pDen:=DenmarkDataArray, LastIdx:=PriceDataArray.tC
-                Out_Table_2 _
-                        TheRange:=.Range(TABLE_2).Cells(1, 1), _
-                        TheComment:=.Range("TABLE_COMMENT"), _
-                        pPD:=PriceDataArray, _
-                        pDen:=DenmarkDataArray
-                Out_Table_3 TheRange:=.Range(TABLE_3).Cells(1, 1), pDen:=DenmarkDataArray
-                Out_Table_4 TheRange:=.Range(TABLE_4).Cells(1, 1), pPD:=PriceDataArray
-                With .Range(TABLE_1)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_2)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_3)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_4)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-            End With
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = True
-        Else
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-'7)   Free unused memory
-        free_unused_memory PriceDataArray, DenmarkDataArray
-    End With
-End Function
-
-Sub allocate_memory(pPriceData As TPriceData, pDenmarkData As TDenmark, memsize As Integer)
-'  ������ ��� TDenmark
-    ReDim pDenmarkData.ResistanceLine(1 To memsize)
-    ReDim pDenmarkData.ResistancePoints(1 To memsize)
-    ReDim pDenmarkData.SupportLine(1 To memsize)
-    ReDim pDenmarkData.SupportPoints(1 To memsize)
-   
-' ������������� ������ �� �����
-    pPriceData.tC = memsize
-    ReDim pPriceData.D(1 To memsize)
-    ReDim pPriceData.Tm(1 To memsize)
-    ReDim pPriceData.Opn(1 To memsize)
-    ReDim pPriceData.Hgh(1 To memsize)
-    ReDim pPriceData.Lw(1 To memsize)
-    ReDim pPriceData.Cls(1 To memsize)
-    ReDim pPriceData.Vl(1 To memsize)
-
-End Sub
-
-Sub free_unused_memory(pP As TPriceData, pD As TDenmark)
-'   Free Prices
-    pP.tC = 0
-    Erase pP.D
-    Erase pP.Tm
-    Erase pP.Opn
-    Erase pP.Hgh
-    Erase pP.Lw
-    Erase pP.Cls
-    Erase pP.Vl
-    
-'Free TDenmark
-    Erase pD.ResistanceLine
-    Erase pD.ResistancePoints
-    Erase pD.SupportLine
-    Erase pD.SupportPoints
-End Sub
-
-
-'*****************************************
-Sub DetDenmark(pPriceData As TPriceData, pDenmarkData As TDenmark, ByVal ClosePrev2 As Boolean, ByVal CloseSucc1 As Boolean)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPriceData  - ����, ����������� ����� ������ �� ����� (����������)
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' pDenmarkData - �������� ������ �������� (������ ��������, SignalParameter - ���������):
-' ����� ResistanceLine,SupportLine �� �������, ������� �����, ������� � ������� ��� �������
-' SignalValue = 0 ������ �����������
-' SignalValue < 0 ������ ����������� ������ (������ �������)
-' SignalValue > 0 ������ ����������� ������ (������ �������)
-' ���� pDenmarkData.ResistancePointCount < 2, �� �������� ResistanceLine �� ������������
-' ���� pDenmarkData.SupportPointsCount < 2, �� �������� SupportLine �� ������������
-
-' ��������� ���������
-    Const QUALIFICATOR_DISABLE As String = "-"
-    Const QUALIFICATOR_ENABLE As String = "Signal"
-    
-    Dim UpQual(1 To 3) As String
-    Dim DownQual(1 To 3) As String
-    Dim UpSignal, DownSignal As Integer
-    Dim i As Integer
-    
-    pDenmarkData.SignalValue = 0
-    UpSignal = 0
-    DownSignal = 0
-    
-    For i = 1 To 3
-        pDenmarkData.Qualificator(i) = QUALIFICATOR_DISABLE
-        UpQual(i) = QUALIFICATOR_DISABLE
-        DownQual(i) = QUALIFICATOR_DISABLE
-    Next i
-    
-' ����������� ����� ��������� � �������������
-    ResLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.ResistancePointCount, _
-        pDenmarkData.ResistanceLine, _
-        pDenmarkData.ResistancePoints, _
-        ClosePrev2, _
-        CloseSucc1
-        
-    SuppLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.SupportPointsCount, _
-        pDenmarkData.SupportLine, _
-        pDenmarkData.SupportPoints, _
-        ClosePrev2, _
-        CloseSucc1
-
-        
-        
-    If pDenmarkData.ResistancePointCount >= 2 Then
-        pDenmarkData.ResistanceAngle = 57.29578 * _
-            Atn(pDenmarkData.ResistanceLine(pPriceData.tC) - _
-                pDenmarkData.ResistanceLine(pPriceData.tC - 1))
-    End If
-    If pDenmarkData.SupportPointsCount >= 2 Then
-        pDenmarkData.SupportAngle = 57.29578 * _
-            Atn(pDenmarkData.SupportLine(pPriceData.tC) - _
-                pDenmarkData.SupportLine(pPriceData.tC - 1))
-    End If
-
-' ������������ ������� ----------------------------------
-    Dim t As Integer
-' 1. ������ ����������� ������: ResistanceLine ��������� � ResistanceLine ������ *************
-    If pDenmarkData.ResistancePointCount >= 2 And pDenmarkData.ResistanceAngle < 0 Then
-'    ����������� ������� ������� �����
-        If pDenmarkData.ResistanceLine(pPriceData.tC) < pPriceData.Cls(pPriceData.tC) Then
-            UpSignal = 1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) > pDenmarkData.ResistanceLine(t) Then
-                    UpSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If UpSignal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) > pPriceData.Cls(pPriceData.tC - 1) Then
-                UpSignal = UpSignal + 1
-                UpQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: open > ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) > pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - demand value < ResistanceLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Lw(pPriceData.tC - 1) < pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-    End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: SupportLine ��������� � SupportLine ������
-    If pDenmarkData.SupportPointsCount >= 2 And pDenmarkData.SupportAngle > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-        If pPriceData.Cls(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-            DownSignal = -1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) < pDenmarkData.SupportLine(t) Then
-                    DownSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If DownSignal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) < pPriceData.Cls(pPriceData.tC - 1) Then
-                DownSignal = DownSignal - 1
-                DownQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: Open ���� ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - supply value(t-1) > SupportLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Hgh(pPriceData.tC - 1) > pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-'    ---------------------------------------------
-    End If
-'      ���������� ������������ ���������
-    If Abs(DownSignal) <> UpSignal Then
-        If Abs(DownSignal) > UpSignal Then
-            pDenmarkData.SignalValue = DownSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = DownQual(i)
-            Next i
-        Else
-            pDenmarkData.SignalValue = UpSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = UpQual(i)
-            Next i
-        End If
-    End If
-End Sub
-
-Sub DetProj(pPriceData As TPriceData, pDenmarkData As TDenmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-    Dim pM As Double, t As Integer, Tm As Integer, tL As Integer
-
-    If pDenmarkData.SignalValue >= 2 Then  ' ������ �������
-
-        tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount)     ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2 Then
-'           t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < ResistanceLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Lw(Tm) ' L(t-1) < ResistanceLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Lw(t) < pM And pPriceData.Lw(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Lw(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
-'               P1( tb) = ResistanceLine(tb) + ResistanceLine(t*) - L(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Lw(Tm)
-            Else
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If ' pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < ResistanceLine(t)}
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Cls(t) < pM And pPriceData.Cls(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue >= 2
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-    If pDenmarkData.SignalValue <= -2 Then
-        tL = pDenmarkData.SupportPoints(pDenmarkData.SupportPointsCount)  ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.SupportPointsCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber = 1 Or pDenmarkData.ProjectNumber = 2 Then
-'           t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > SupportLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Hgh(Tm) ' H(t-1) > SupportLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Hgh(t) > pM And pPriceData.Hgh(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Hgh(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
- '              P1( tb) = SupportLine(tb) + SupportLine(t*) - H(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Hgh(Tm)
-            Else
-'               P2( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  SupportLine(t)}
-'           P3( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pM < pPriceData.Cls(t) And pPriceData.Cls(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue <= -2
-End Sub
-
-Sub ResLine(pP As TPriceData, tE As Integer, ResistancePointCount As Integer, _
-            ResistanceLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� ResistanceLine, dom(ResistanceLine)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(ResistancePointCount)}, s(1) < s(2) < ...< s(ResistancePointCount)
-'   ( s(ResistancePointCount)<= tE )- ������� �����
-' 3) ����� ������� ����� ResistancePointCount.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� SupportLine
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-  
-'1 ����������� ������� �������� �������
-    ResistancePointCount = 0
-    For t = 3 To tE - 1
- '      v = max{high(t-1), high(t+1)} < high(t)}
-        v = pP.Hgh(t - 1)
-        If v < pP.Hgh(t + 1) Then
-            v = pP.Hgh(t + 1)
-        End If
-        IsGoodPoint = pP.Hgh(t) > v
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) < pP.Hgh(t))
-        End If
-        
-        If IsGoodPoint Then       'alt.: v >= High(t + 1)
-            s(ResistancePointCount + 1) = t: ResistancePointCount = ResistancePointCount + 1
-        End If
-    Next t
-    
-loop_:
-    
-    If ResistancePointCount < 2 Then
-        GoTo done
-    End If
-
-' 2 ����������� ����� �������������
-    ResistanceLine(s(1)) = pP.Hgh(s(1))
-    For i = 2 To ResistancePointCount
-        ResistanceLine(s(i)) = pP.Hgh(s(i))
-        v = (pP.Hgh(s(i)) - pP.Hgh(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            ResistanceLine(t) = pP.Hgh(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(ResistancePointCount) < tE Then
-        v = (pP.Hgh(s(ResistancePointCount)) - pP.Hgh(s(ResistancePointCount - 1))) / (s(ResistancePointCount) - s(ResistancePointCount - 1))
-        For t = s(ResistancePointCount) + 1 To tE
-            ResistanceLine(t) = pP.Hgh(s(ResistancePointCount - 1)) + v * (t - s(ResistancePointCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To ResistancePointCount
-            If ResistanceLine(s(t) + 1) < pP.Cls(s(t) + 1) Then
-                ResistancePointCount = ResistancePointCount - 1
-                ' ������� �����
-                For i = t To ResistancePointCount
-                    s(i) = s(i + 1)
-                Next i
-                s(ResistancePointCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(ResistanceLine)
-                Rb = UBound(ResistanceLine)
-                Erase ResistanceLine
-                ReDim ResistanceLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-    
-done:
-End Sub
-
-Sub SuppLine(pP As TPriceData, tE As Integer, SupportPointsCount As Integer, _
-               SupportLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� SupportLine, dom(SupportLine)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(SupportPointsCount)}, s(1) < s(2) < ...< s(SupportPointsCount) -
-'    ������� �����
-' 3) ����� ������� ����� SupportPointsCount.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-    
-'1 ����������� ������� �������� �������
-     SupportPointsCount = 0
-    For t = 3 To tE - 1
-'       v = min{Low(t-1), Low(t+1)} > Low(t)
-        v = pP.Lw(t - 1)
-        If v > pP.Lw(t + 1) Then
-            v = pP.Lw(t + 1)
-        End If
-        
-        IsGoodPoint = pP.Lw(t) < v
-        
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) > pP.Lw(t))
-        End If
-        
-        If IsGoodPoint Then     'alt.: v >= High(t + 1)
-            s(SupportPointsCount + 1) = t: SupportPointsCount = SupportPointsCount + 1
-        End If
-    Next t
-
-loop_:
-    If SupportPointsCount < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� ���������
-    
-    SupportLine(s(1)) = pP.Lw(s(1))
-    For i = 2 To SupportPointsCount
-        SupportLine(s(i)) = pP.Lw(s(i))
-        v = (pP.Lw(s(i)) - pP.Lw(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            SupportLine(t) = pP.Lw(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(1) < tE Then
-        v = (pP.Lw(s(SupportPointsCount)) - pP.Lw(s(SupportPointsCount - 1))) / (s(SupportPointsCount) - s(SupportPointsCount - 1))
-        For t = s(SupportPointsCount) + 1 To tE
-            SupportLine(t) = pP.Lw(s(SupportPointsCount - 1)) + v * (t - s(SupportPointsCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To SupportPointsCount
-            If SupportLine(s(t) + 1) > pP.Cls(s(t) + 1) Then
-                SupportPointsCount = SupportPointsCount - 1
-                ' ������� �����
-                For i = t To SupportPointsCount
-                    s(i) = s(i + 1)
-                Next i
-                s(SupportPointsCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(SupportLine)
-                Rb = UBound(SupportLine)
-                Erase SupportLine
-                ReDim SupportLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-done:
-End Sub
-
-<<<<<<
-======================
-mChart
->>>>>>
-Attribute VB_Name = "mChart"
-Option Explicit
-
-Const CHART_NAME As String = "PriceChart"
-
-Sub Draw_Chart(SignalDefined As Boolean)
-
-    Dim n As Integer
-    Dim theChart As Chart
-    Dim ChartDataAria, szLastNumber As String
-    Dim MinYScale As Double
-    
-    
-    With ThisWorkbook
-' Checking data
-' Disable screen out
-        .Application.Cursor = xlWait
-        .Application.ScreenUpdating = False
-' Create series range
-        n = GetLinesCount(Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE))
-        szLastNumber = n + 1
-        If SignalDefined Then
-            ChartDataAria = "A2:A" & szLastNumber _
-                        & ",D2:D" & szLastNumber _
-                        & ",G2:G" & szLastNumber _
-                        & ",I2:K" & szLastNumber
-        Else
-            ChartDataAria = "A2:A" & szLastNumber _
-                        & ",D2:D" & szLastNumber _
-                        & ",G2:G" & szLastNumber _
-                        & ",I2:J" & szLastNumber
-        End If
-        MinYScale = GetMinValue(.Worksheets(RAW_DATA_SHEET).Range(ChartDataAria))
-' Find and delete old chart
-        .Worksheets(CHART_SHEET).Unprotect
-        Dim WindowWidth, WindowHeight As Integer
-        With .Worksheets(CHART_SHEET)
-            WindowWidth = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            WindowHeight = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-        
-        
-        With .Worksheets(CHART_SHEET).ChartObjects
-            .Delete
-            With .Add(5, 5, WindowWidth - 10, WindowHeight - 10)
-                .SendToBack
-                Set theChart = .Chart
-            End With
-' Create a chart
-        End With
-        With theChart
-            .ChartType = xlLine
-            .SetSourceData Source:=Sheets(RAW_DATA_SHEET).Range( _
-                    ChartDataAria), PlotBy:=xlColumns
-'                   .Location Where:=xlLocationAsObject, Name:=CHART_SHEET
-            .HasTitle = True
-            With .ChartTitle
-                .Text = ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE).Value
-                With .Font
-                    .Size = 8
-                    .Bold = True
-                End With
-            End With
-            .HasLegend = True
-            With .Legend
-                .Position = xlTop
-                With .Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            .HasDataTable = False
-            With .Axes(xlCategory)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                .TickLabels.Orientation = xlUpward
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .CrossesAt = 1
-                .TickLabelSpacing = 1
-                .TickMarkSpacing = 1
-                .AxisBetweenCategories = False
-                .ReversePlotOrder = False
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            With .Axes(xlValue)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .MinimumScale = MinYScale
-                .MaximumScaleIsAuto = True
-                .MinorUnitIsAuto = True
-                .MajorUnitIsAuto = True
-                .Crosses = xlCustom
-                .CrossesAt = MinYScale
-                .ReversePlotOrder = False
-                .ScaleType = xlLinear
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            .ChartTitle.Top = 5
-            .ChartTitle.Left = 5
-            With .Legend
-                .Top = 5
-                .Fill.OneColorGradient _
-                    Style:=msoGradientHorizontal, _
-                    Variant:=3, _
-                    Degree:=0.303913939116503
-                .Fill.Visible = True
-                .Fill.ForeColor.SchemeColor = 71
-            End With
-            .PlotArea.Left = 10
-            .PlotArea.Top = .Legend.Top + .Legend.Height + 5
-            .PlotArea.Width = .ChartArea.Width - 20
-            .PlotArea.Height = .ChartArea.Height - .PlotArea.Top
-            
-' Tune OPEN line
-            With .SeriesCollection(1)
-                .Border.LineStyle = xlNone
-                .MarkerBackgroundColorIndex = xlNone
-                .MarkerForegroundColorIndex = 1
-                .MarkerStyle = xlPlus
-                .Smooth = False
-                .MarkerSize = 9
-                .Shadow = False
-            End With
-' Tune CLOSE line
-            With .SeriesCollection(2)
-                .Border.ColorIndex = 10
-                .Border.Weight = xlMedium
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune RESISTANCE line
-            With .SeriesCollection(3)
-                .Border.ColorIndex = 3
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune SUUPORT line
-            With .SeriesCollection(4)
-                .Border.ColorIndex = 25
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-            If SignalDefined Then
-                With .SeriesCollection(5)
-                    .Border.ColorIndex = 6
-                    .Border.Weight = xlThin
-                    .Border.LineStyle = xlDot
-                End With
-            End If
-        End With
-        .Application.Cursor = xlDefault
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Protect userInterfaceOnly:=True
-        End With
-    End With
-End Sub
-
-Function GetMinValue(DataRange As Range) As Double
-    Dim Cell As Range
-    Dim MinValue, MaxValue, RangeValue, CorrectValue, Mult As Double
-    MinValue = MAX_PRICE_VALUE
-    MaxValue = MIN_PRICE_VALUE
-    For Each Cell In DataRange
-        If Not IsEmpty(Cell) And IsNumeric(Cell) Then
-            If Cell > MIN_PRICE_VALUE Then
-                If Cell < MinValue Then
-                    MinValue = Cell
-                End If
-                If Cell > MaxValue Then
-                    MaxValue = Cell
-                End If
-            End If
-        End If
-    Next
-    RangeValue = MaxValue - MinValue
-    If RangeValue < 0 Then
-        MinValue = 0
-    Else
-        CorrectValue = RangeValue / 4
-        Mult = MIN_PRICE_VALUE
-        While MinValue - Int(MinValue * Mult) / Mult > CorrectValue
-            Mult = Mult * 10
-        Wend
-        MinValue = Int(MinValue * Mult) / Mult
-    End If
-    GetMinValue = MinValue
-End Function
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{F2CF310F-F99B-428A-9EA4-35CA19429F9D}{CECE7A6F-1D1D-47DF-AE0E-E6EAFC692914}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-mWebQeury
->>>>>>
-Attribute VB_Name = "mWebQeury"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .Name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.Name = QryName Then
-            WebQuery.Delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.Name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-Attribute CreateCommandBar.VB_ProcData.VB_Invoke_Func = "R\n14"
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Contents"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 49
-                        .OnAction = "cmHelpContents"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mTool
->>>>>>
-Attribute VB_Name = "mTool"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub tool_delete_all_tables()
-    QryDelete ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range("A1")
-End Sub
-
-Sub tool_delete_all_charts(theSheet As Worksheet)
-    Dim theChart As Chart
-    For Each theChart In theSheet
-        theChart.Unprotect
-        theChart.Delete
-    Next
-End Sub
-
-Sub DateTimeTest()
-    Dim the_date
-    Dim the_time
-    the_date = DateValue(Now)
-    the_time = TimeValue(Now)
-End Sub
-
-
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{57513C6C-49E1-468C-B487-CCDA83083AF1}{4BF9D9B0-BBEB-400E-B2EF-800B8C4C6694}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-
-Private Sub App_WorkbookOpen(ByVal wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.count > 1 Then
-        wbname = wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-mDataCommands
->>>>>>
-Attribute VB_Name = "mDataCommands"
-Option Explicit
-
-Sub evFileOpen()
-    Dim fileToOpen As String
-    Dim wb As Workbook
-    Dim ticker As String
-    Dim Result As Integer
-
-    fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt, Data Files (*.csv), *.csv")
-    Set wb = ThisWorkbook
-    With wb
-        If fileToOpen <> "False" Then
-            If .Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = True Then
-                .Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = False
-            End If
-            .Worksheets(FORM_SHEET).Range(FILE_NAME) = fileToOpen
-            Result = UpdateHistoryFromFile(wb, fileToOpen)
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            
-            ClearResultTables
-            
-            Select Case Result
-                Case FUNCRES_FILE_OK
-                    .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = True
-                    If TDenmark_Calc Then
-                        With .Worksheets(RAW_DATA_SHEET)
-                            ticker = .Range("B1")
-                        End With
-                        With .Worksheets(FORM_SHEET)
-                            .Range("CALC_TICKER_NAME") = ticker
-                        End With
-                    End If
-                Case FUNCRES_FILE_VERY_SMALL
-                    .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_VERY_SMALL
-                    MsgBox MSG_FILE_VERY_SMALL, vbOKOnly, PROGRAM_NAME
-                Case FUNCRES_FILE_INVALID_FORMAT
-                    .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_INVALID_FORMAT
-                    MsgBox MSG_FILE_INVALID_FORMAT, vbOKOnly, PROGRAM_NAME
-                End Select
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-    End With 'wb
-End Sub
-
-Sub evSubmit_Click()
-    Dim ticker As String
-    Dim Period As String
-
-    Application.Cursor = xlWait
-    Dim wb As Workbook
-    Set wb = ThisWorkbook
-    With wb
-        With .Worksheets(VAR_SHEET)
-            ticker = .Range("DEN_SYMBOL")
-            Period = .Range("DEN_TIME")
-            If .Range("BOOL_DATA_READY") = False Or .Range("BOOL_LOAD_DATA") = True Then
-                .Range("BOOL_DATA_READY") = UpdateHistoryFromWeb(wb)
-            End If
-            .Range("BOOL_DEMARK_READY") = False
-        End With
-        If .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False Then
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            
-            ClearResultTables
-            
-            With .Worksheets(FORM_SHEET)
-                .Range("CALC_TICKER_NAME") = ticker & ", Period=" & Period
-                .Range("FILE_NAME") = ""
-                .Range(TABLE_COMMENT).Value = "������������ ������"
-            End With
-        Else
-            If TDenmark_Calc Then
-                With .Worksheets(FORM_SHEET)
-                    .Range("CALC_TICKER_NAME") = ticker & ", Period=" & Period
-                    .Range("FILE_NAME") = ""
-                End With
-            End If
-        End If
-    End With
-    Application.Cursor = xlDefault
-End Sub
-
-Sub evTicker_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SECNAME") = .Range("IDX_DEN_SYMBOL")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evSecName_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SYMBOL") = .Range("IDX_DEN_SECNAME")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evLastInterval_Change()
-    MsgBox "�� �������� � ���� ������"
-End Sub
-
-Sub evHistory_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_DATA_READY") = False
-    End With
-End Sub
-
-Sub evGroupChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        GroupIdx = .Range("IDX_DEN_LIST")
-        .Range("IDX_DEN_SYMBOL") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat.ListFillRange = NewCbxRange
-        NewRangeOffsetCol = NewRangeOffsetCol + 1
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat.ListFillRange = NewCbxRange
-    End With
-    evTicker_Change
-End Sub
-
-Sub evUpdateTickerList()
-    UpdateTickerList ThisWorkbook
-    evHistory_Change
-End Sub
-<<<<<<
-======================
-mGetFileData
->>>>>>
-Attribute VB_Name = "mGetFileData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Public Const MAX_LOAD_DATA_LINES As Integer = 16000
-
-Public Const MSG_FILE_VERY_SMALL As String = "� ����� ������������ ������"
-Public Const MSG_FILE_INVALID_FORMAT As String = "�������� ������ �����"
-
-Public Const FUNCRES_FILE_OK As Integer = 0
-Public Const FUNCRES_FILE_VERY_SMALL As Integer = -1
-Public Const FUNCRES_FILE_INVALID_FORMAT As Integer = -2
-
-Function UpdateHistoryFromFile(wb As Workbook, fileToOpen As String) As Integer
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    Dim SingleFileLine As String
-    Dim FileHandler As Integer
-    Dim i, j, row_idx As Integer
-    
-    UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = True
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            'Clear table include temp area
-            .Parent.Application.DisplayAlerts = False
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            
-            ' Reading data from file
-            FileHandler = FreeFile
-            row_idx = 0
-            Open fileToOpen For Input As #FileHandler
-            Do While Not EOF(FileHandler) And row_idx < MAX_LOAD_DATA_LINES
-                Line Input #FileHandler, SingleFileLine
-                .Range(PRICE_TABLE).Offset(row_idx, 0) = SingleFileLine
-                row_idx = row_idx + 1
-            Loop
-            Close #FileHandler
-            
-            ' Parsing data
-            DestRangeName = "=" & RAW_DATA_SHEET & "!$B$1:$B" & row_idx
-            ResultLength = row_idx
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-            .Parent.Application.DisplayAlerts = True
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            
-            If Not CheckFileFormat(RawData.Offset(-1, 0)) Then
-                UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-                Exit Function
-            End If
-            
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).Delete xlShiftUp
-            Else
-                UpdateHistoryFromFile = FUNCRES_FILE_VERY_SMALL
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).Delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromFile = FUNCRES_FILE_OK
-End Function
-
-Function CheckFileFormat(HeaderString As Range) As Boolean
-    With HeaderString
-        CheckFileFormat = _
-            .Offset(0, DATE_IDX) = "Date" And _
-            .Offset(0, TIME_IDX) = "Time" And _
-            .Offset(0, OPEN_IDX) = "Open" And _
-            .Offset(0, CLOSE_IDX) = "Close" And _
-            .Offset(0, LOW_IDX) = "Low" And _
-            .Offset(0, HIGH_IDX) = "High" And _
-            .Offset(0, VOLUME_IDX) = "Volume"
-    End With
-End Function
-<<<<<<
-Project Name : 'Denmark_method'
-Quirk - duff tag length======================
-MGetWebData
->>>>>>
-Attribute VB_Name = "MGetWebData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Const QueryDataName As String = "ExternalDenmarkData"
-
-Function UpdateHistoryFromWeb(Wb As Workbook) As Boolean
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    UpdateHistoryFromWeb = False
-    QryPathStr = GetQryPath(Wb)
-    With Wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = IsNumeric(.Range("DEN_TIME"))
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table include temp area
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-    
-    '        .Parent.Application.DisplayAlerts = False
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-    '        .Parent.Application.DisplayAlerts = True
-            Dim i, j, row_idx As Integer
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).delete xlShiftUp
-            Else
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).delete xlShiftUp
-                End If
-            Else
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = "'" & Location.Cells(1 + row_idx, 1)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And TimeValue(Now) < TimeSerial(18, 0, 0)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromWeb = True
-End Function
-
-Private Function GetQryPath(Wb As Workbook) As String
-    Dim QryPathStr As String
-    Dim IsIntradai As Boolean
-    Dim DayCount As Integer
-    With Wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/online/nph-single.cgi?"
-        QryPathStr = QryPathStr & "ticker=" & .Range("DEN_SYMBOL")
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        IsIntradai = IsNumeric(.Range("DEN_TIME"))
-        If IsIntradai Then
-            QryPathStr = QryPathStr & "&period=" & .Range("DEN_TIME")
-        Else
-            QryPathStr = QryPathStr & "&period=60"
-        End If
-        QryPathStr = QryPathStr & "&oh=11&ch=18"
-        QryPathStr = QryPathStr & "&separator=%2C"
-        QryPathStr = QryPathStr & "&vmode=Ignore&vtype=BA2"
-        QryPathStr = QryPathStr & "&format=Excel"
-        
-        If IsIntradai Then
-            DayCount = .Range("DEN_HISTORY") * .Range("DEN_TIME") \ 420 + 1 + .Range("DEN_HISTORY")
-        Else
-            DayCount = .Range("DEN_HISTORY")
-        End If
-        QryPathStr = QryPathStr & "&daysback=" & DayCount
-'        .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-    
-End Function
-
-Sub UpdateTickerList(Wb As Workbook)
-    Dim Idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    QryPathStr = GetListPath(Wb)
-    With Wb
-        With .Worksheets(VAR_SHEET)
-            Idx = .Range("IDX_DEN_LIST")
-            Set Location = .Range("TICKER_TABLES").Offset(0, (Idx - 1) * 2)
-             .Range("IDX_DEN_SYMBOL") = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            ' Remove header
-            ' Find [DATA]
-            n = 0
-            Do While Location.Offset(n, 0) <> "[DATA]"
-                n = n + 1
-            Loop
-            .Range(Location.Offset(1, 0), Location.Offset(n, 1)).delete Shift:=xlUp
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-        
-        '        .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 0), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-        ' Setup Ticker List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        ' Setup Name List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Offset(0, 1).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-    End With
-End Sub
-
-Private Function GetListPath(Wb As Workbook) As String
-    Dim QryPathStr As String
-    With Wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/names.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        QryPathStr = QryPathStr & "&category=STOCKS"
-        '.Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            ThisWorkbook.Save
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(FORM_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mReadWrite
->>>>>>
-Attribute VB_Name = "mReadWrite"
-Option Explicit
-
-Public Const GOOD_LINE_STATUS As String = "Ok"
-Public Const BAD_LINE_STATUS As String = "N/A"
-
-Function ReadPricesData(Location As Range, Hist As Integer, dt As Integer, _
-              pPriceData As TPriceData) As Integer
-    '������������� ���� TPriceData �� ������� ���� - 1
-    'k��������� �� ����� ��� hist ��������� �����
-    'aPoint - ������ �������
-    '������ ��� ������ ������� �������������� ������ (������)
-    Dim n, i As Integer
-    
-    '����������� ����� ����� ������� - n
-    n = GetLinesCount(Location)
-    ReadPricesData = n
-    If n < 9 Then             '���������� ������ !!!
-        GoTo done
-    End If
-    ' ����� ����� ���������� ()
-    If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-        Hist = (n - 3) \ dt + 1 '
-    End If
-    Dim t, s As Integer
-    For t = 0 To Hist - 1
-        s = n - t * dt - 1
-        pPriceData.D(Hist - t) = Location.Offset(s, DATE_IDX).Value
-        pPriceData.Tm(Hist - t) = Location.Offset(s, TIME_IDX).Value
-        pPriceData.Opn(Hist - t) = Location.Offset(s, OPEN_IDX).Value
-        pPriceData.Hgh(Hist - t) = Location.Offset(s, HIGH_IDX).Value
-        pPriceData.Lw(Hist - t) = Location.Offset(s, LOW_IDX).Value
-        pPriceData.Cls(Hist - t) = Location.Offset(s, CLOSE_IDX).Value
-        pPriceData.Vl(Hist - t) = Location.Offset(s, VOLUME_IDX).Value
-    Next t
-    ReadPricesData = t + 1
-done:
-End Function
-
-Sub ResultLinesOut(Location As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim n As Integer
-    
-    n = GetLinesCount(Location)
-    With Location
-        .Offset(-1, RESIST_IDX) = "Resistance"
-        .Offset(-1, SUPPORT_IDX) = "Support"
-        .Offset(-1, PROJECT_IDX) = "Project"
-    End With
-    Dim t, count, Idx, loc_idx As Integer
-    count = pPD.tC
-    For t = 0 To count - 1
-        Idx = count - t
-        loc_idx = n - t - 1
-        If pDen.ResistanceLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, RESIST_IDX).Value = pDen.ResistanceLine(Idx)
-        End If
-        If pDen.SupportLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, SUPPORT_IDX).Value = pDen.SupportLine(Idx)
-        End If
-        If Abs(pDen.SignalValue) > 1 Then
-            Location.Offset(loc_idx, PROJECT_IDX).Value = pDen.ProjectPrice
-        End If
-    Next t
-End Sub
-
-Sub Out_Table_1(TheRange As Range, pDen As TDenmark, LastIdx As Integer)
-    
-    
-    ' Col = 2 - �� ��������� !!!
-    ' Status - Col = 0
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(0, 0).Value = BAD_LINE_STATUS
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(1, 0).Value = BAD_LINE_STATUS
-    End If
-    ' -----------------------------------------
-    ' ���� �������� ����� ������������� � ��������� - Col = 1
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 1).Value = pDen.ResistanceAngle
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 1).Value = pDen.SupportAngle
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 1).Value = (pDen.ResistanceAngle + pDen.SupportAngle) / 2
-    End If
-    ' -----------------------------------------
-    ' ������� ���� ����� �������� �� ������� ������
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 2).Value = pDen.ResistanceLine(LastIdx)
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 2).Value = pDen.SupportLine(LastIdx)
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 2).Value = _
-            (pDen.ResistanceLine(LastIdx) + pDen.SupportLine(LastIdx)) / 2
-    End If
-    
-End Sub
-
-Sub Out_Table_2(TheRange As Range, TheComment As Range, pPD As TPriceData, pDen As TDenmark)
-    Const ColorIndexBUY = 5
-    Const ColorIndexSELL = 3
-    Const ColorIndexNOTHINK = 14
-    
-    Dim SignalValue_defined, allert_enable  As Boolean
-    Dim Message As String
-    SignalValue_defined = False
-    allert_enable = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_ALLERT_DLG")
-    Message = "������ �� ��������� ������ �� ���������������."
-    If pDen.SignalValue >= 2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "BUY"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexBUY
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue - 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "BUY Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & pDen.SignalValue - 1 & " ! "
-    End If
-    If pDen.SignalValue <= -2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "SELL"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexSELL
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue + 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "SELL Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(pDen.SignalValue + 1) & "!"
-    End If
-    With TheComment
-        .Value = Message
-        .Font.Bold = True
-        Dim color_idx As Integer
-        If SignalValue_defined Then
-            If pDen.SignalValue > 0 Then
-                .Font.ColorIndex = ColorIndexBUY
-            Else
-                .Font.ColorIndex = ColorIndexSELL
-            End If
-        Else
-            .Font.ColorIndex = ColorIndexNOTHINK
-        End If
-    End With
-    If allert_enable And SignalValue_defined Then
-        MsgBox _
-            Prompt:=Message, _
-            Title:=PROGRAM_NAME, _
-            Buttons:=vbOKOnly + vbInformation
-    End If
-End Sub
-
-Sub Out_Table_3(TheRange As Range, pDen As TDenmark)
-    Dim i As Integer
-    For i = 1 To 3
-        TheRange.Offset(i - 1, 0).Value = pDen.Qualificator(i)
-    Next i
-End Sub
-
-Sub Out_Table_4(TheRange As Range, pPD As TPriceData)
-    Dim LastIdx As Integer
-    LastIdx = pPD.tC
-    With TheRange
-        .Offset(0, 0).Value2 = "'" & pPD.D(LastIdx)
-        .Offset(0, 1).Value2 = "'" & pPD.Tm(LastIdx)
-        .Offset(0, 2) = pPD.Opn(LastIdx)
-        .Offset(0, 3) = pPD.Hgh(LastIdx)
-        .Offset(0, 4) = pPD.Lw(LastIdx)
-        .Offset(0, 5) = pPD.Cls(LastIdx)
-        .Offset(0, 6) = pPD.Cls(LastIdx) - pPD.Cls(LastIdx - 1)
-    End With
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Denmark method bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(FORM_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-            .Select
-        End With
-        With .Worksheets(CHART_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-        End With
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Unprotect
-        End With
-        With .Worksheets(FORM_SHEET)
-            .Select
-            .Unprotect
-        End With
-        .Application.ScreenUpdating = True
-        
-    End With
-End Sub
-
-<<<<<<
-======================
-mTypes
->>>>>>
-Attribute VB_Name = "mTypes"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "����� �-�� �������"
-Public Const PROGRAM_VERSION As String = "version 3.0 Professional"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-'Public Const ESTIMATION_DATE As Long = 19980915
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "J27"
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const PRICE_TABLE As String = "B1"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-Public Const VAR_SHEET As String = "Var_s"
-
-Public Const CHART_SHEET As String = "Chart"
-
-Public Const MIN_PRICE_VALUE As Double = 0.000001
-Public Const MAX_PRICE_VALUE As Double = 1000000000
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const CLOSE_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const HIGH_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const RESIST_IDX As Integer = 7
-Public Const SUPPORT_IDX As Integer = 8
-Public Const PROJECT_IDX As Integer = 9
-
-Public Const DATE_STAMP_OFFSET = PROJECT_IDX + 1
-Public Const TIME_STAMP_OFFSET = PROJECT_IDX + 4
-Public Const DATE_TIME_STAMP_SIZE = 5
-
-Type TPriceData
-    D() As String      ' ����������� ����
-    Tm() As String     ' �����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Double     ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type TDenmark
-   ResistanceLine() As Double           'Resistance line
-   ResistancePoints() As Integer        'Resistance pivot points
-   ResistancePointCount As Integer      'The number of resistance pivot points
-   ResistanceAngle As Double            'Angle of Declination of ResistanceLine
-   
-   SupportLine() As Double              'Support line
-   SupportPoints() As Integer           'Support pivot points
-   SupportPointsCount As Integer        'The number of support pivot points
-   SupportAngle As Double               ' Angle of Declination of SupportLine
-   
-   SignalParameter     As Integer       ' parameter for SignalValue
-   SignalValue      As Integer          'SignalValue
-   
-   
-   Qualificator(1 To 3) As String       ' qualificators
- 
-   ProjectNumber As Integer             ' ����� ��������
-   ProjectPrice  As Double              ' �������� ����
-   
-End Type
-
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-Dim AppRunEnable As New cEnableRun
-
-Sub evParamChange()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-End Sub
-
-Sub cmViewChart(Optional SwapPage As Boolean = True)
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_CHART_READY") = False
-        If .Range("BOOL_DEMARK_READY") <> True Then
-            If .Range("BOOL_AUTORECALC") = True Then
-                evSubmit_Click
-                If .Range("BOOL_DEMARK_READY") <> True Then
-                    Exit Sub
-                End If
-            Else
-                MsgBox _
-                    "������ �� ����� ���� ��������." & vbCrLf & "�������� ������ �� ����������.", _
-                    vbOKOnly + vbExclamation, _
-                    PROGRAM_NAME
-                Exit Sub
-            End If
-        End If
-    End With
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        With .Range("TABLE_1")
-            Dim test_lines As Boolean
-            test_lines = StrComp(.Cells(1, 1).Value, GOOD_LINE_STATUS)
-            test_lines = test_lines + StrComp(.Cells(2, 1).Value, GOOD_LINE_STATUS)
-            If test_lines <> 0 Then
-                MsgBox _
-                    Prompt:="������ �� ����� ���� ��������." & vbCrLf & "������� ����� �� ���������� .", _
-                    Title:=PROGRAM_NAME, _
-                    Buttons:=vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End With
-        Draw_Chart Not IsEmpty(.Range("TABLE_2").Cells(1, 1))
-    End With
-    With ThisWorkbook
-        .Worksheets(VAR_SHEET).Range("BOOL_CHART_READY") = True
-        If SwapPage Then
-            .Worksheets(CHART_SHEET).Select
-        End If
-    End With
-End Sub
-
-Sub cmViewForm()
-    With ThisWorkbook
-        .Worksheets(FORM_SHEET).Select
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Dim ResistanceLine
-    ResistanceLine = MsgBox( _
-        Prompt:="�� ������� ��������� ���������?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If ResistanceLine = vbYes Then
-       Application.Quit
-    End If
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Demark.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    ProtectionEnable Wb:=ThisWorkbook
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmPrint()
-    If MsgBox( _
-            Prompt:="�� ������� ����������� ���������?", _
-            Buttons:=vbYesNo + vbQuestion, _
-            Title:=PROGRAM_NAME) = vbNo _
-    Then
-        Exit Sub
-    End If
-    Dim s_ticker, s_name, s_time As String
-    s_ticker = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME")
-    s_name = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_NAME")
-    s_time = Now
-    Application.ScreenUpdating = False
-    cmViewChart SwapPage:=False
-    Application.ScreenUpdating = False
-    With ThisWorkbook.Worksheets(FORM_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    With ThisWorkbook.Worksheets(CHART_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    Application.ScreenUpdating = False
-    ThisWorkbook.Worksheets(Array("MainForm", "Chart")).PrintOut Copies:=1, Collate:=True
-    cmViewForm
-End Sub
-<<<<<<
-======================
-mDemark
->>>>>>
-Attribute VB_Name = "mDemark"
-Option Explicit
-
-Public Const FORM_SHEET As String = "MainForm"
-
-'Form Ranges
-Public Const FILE_NAME As String = "FILE_NAME"
-Public Const TABLE_1 As String = "TABLE_1"
-Public Const TABLE_2 As String = "TABLE_2"
-Public Const TABLE_3 As String = "TABLE_3"
-Public Const TABLE_4 As String = "TABLE_4"
-Public Const TABLE_COMMENT As String = "TABLE_COMMENT"
-
-'�������� ��� ������ - �������� 1
-
-'*********************
-Dim PriceDataArray As TPriceData
-Dim DenmarkDataArray As TDenmark
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Sub ClearResultTables()
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        .Range(TABLE_1).ClearContents ' �������-1
-        .Range(TABLE_2).ClearContents ' �������-2
-        .Range(TABLE_3).ClearContents ' �������-3
-        .Range(TABLE_COMMENT).Value = "" ' ����������-3
-        .Range(TABLE_4).ClearContents ' �������-4
-    End With
-End Sub
-
-Function TDenmark_Calc() As Boolean
-    
-    Dim nWindow As Integer
-    Dim bPrevCloseFilter, bSuccCloseFilter As Boolean
-    
-    TDenmark_Calc = False
-    
-    mobjAppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-'1)    Read User data
-        With .Worksheets(VAR_SHEET)
-            DenmarkDataArray.ProjectNumber = .Range("DEN_PROECT").Value
-            DenmarkDataArray.SignalParameter = .Range("DEN_PARAM").Value
-            nWindow = .Range("DEN_WINDOW").Value
-            bPrevCloseFilter = .Range("BOOL_PREV_CLOSE").Value
-            bSuccCloseFilter = .Range("BOOL_SUCC_CLOSE").Value
-        End With
-
-'2)   Memory allocation
-        allocate_memory PriceDataArray, DenmarkDataArray, nWindow
-
-'3)   Read data
-        Dim TheRange As Range
-        Set TheRange = .Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE)
-        Dim LinesCount As Integer
-        LinesCount = ReadPricesData(Location:=TheRange, Hist:=PriceDataArray.tC, dt:=1, pPriceData:=PriceDataArray)
-        
-        'Init function result
-        TDenmark_Calc = LinesCount >= nWindow
-        
-        If LinesCount >= nWindow Then
-        
-'4)   Calculate metod TDenmarkDataArray
-            DetDenmark PriceDataArray, DenmarkDataArray, bPrevCloseFilter, bSuccCloseFilter
-            If Abs(DenmarkDataArray.SignalValue) > 1 Then  '������� ���������, ���� ���� ������
-                DetProj PriceDataArray, DenmarkDataArray
-            End If
-'5)   Write result
-            Application.ScreenUpdating = False
-    
-'6)    Clear interface tables
-            ClearResultTables
-            
-            ResultLinesOut Location:=TheRange.Offset(2, 0), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-            
-            With .Worksheets(FORM_SHEET)
-                Out_Table_1 TheRange:=.Range(TABLE_1).Cells(1, 1), pDen:=DenmarkDataArray, LastIdx:=PriceDataArray.tC
-                Out_Table_2 _
-                        TheRange:=.Range(TABLE_2).Cells(1, 1), _
-                        TheComment:=.Range("TABLE_COMMENT"), _
-                        pPD:=PriceDataArray, _
-                        pDen:=DenmarkDataArray
-                Out_Table_3 TheRange:=.Range(TABLE_3).Cells(1, 1), pDen:=DenmarkDataArray
-                Out_Table_4 TheRange:=.Range(TABLE_4).Cells(1, 1), pPD:=PriceDataArray
-                With .Range(TABLE_1)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_2)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_3)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_4)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-            End With
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = True
-        Else
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-'7)   Free unused memory
-        free_unused_memory PriceDataArray, DenmarkDataArray
-    End With
-End Function
-
-Sub allocate_memory(pPriceData As TPriceData, pDenmarkData As TDenmark, memsize As Integer)
-'  ������ ��� TDenmark
-    ReDim pDenmarkData.ResistanceLine(1 To memsize)
-    ReDim pDenmarkData.ResistancePoints(1 To memsize)
-    ReDim pDenmarkData.SupportLine(1 To memsize)
-    ReDim pDenmarkData.SupportPoints(1 To memsize)
-   
-' ������������� ������ �� �����
-    pPriceData.tC = memsize
-    ReDim pPriceData.D(1 To memsize)
-    ReDim pPriceData.Tm(1 To memsize)
-    ReDim pPriceData.Opn(1 To memsize)
-    ReDim pPriceData.Hgh(1 To memsize)
-    ReDim pPriceData.Lw(1 To memsize)
-    ReDim pPriceData.Cls(1 To memsize)
-    ReDim pPriceData.Vl(1 To memsize)
-
-End Sub
-
-Sub free_unused_memory(pP As TPriceData, pD As TDenmark)
-'   Free Prices
-    pP.tC = 0
-    Erase pP.D
-    Erase pP.Tm
-    Erase pP.Opn
-    Erase pP.Hgh
-    Erase pP.Lw
-    Erase pP.Cls
-    Erase pP.Vl
-    
-'Free TDenmark
-    Erase pD.ResistanceLine
-    Erase pD.ResistancePoints
-    Erase pD.SupportLine
-    Erase pD.SupportPoints
-End Sub
-
-
-'*****************************************
-Sub DetDenmark(pPriceData As TPriceData, pDenmarkData As TDenmark, ByVal ClosePrev2 As Boolean, ByVal CloseSucc1 As Boolean)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPriceData  - ����, ����������� ����� ������ �� ����� (����������)
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' pDenmarkData - �������� ������ �������� (������ ��������, SignalParameter - ���������):
-' ����� ResistanceLine,SupportLine �� �������, ������� �����, ������� � ������� ��� �������
-' SignalValue = 0 ������ �����������
-' SignalValue < 0 ������ ����������� ������ (������ �������)
-' SignalValue > 0 ������ ����������� ������ (������ �������)
-' ���� pDenmarkData.ResistancePointCount < 2, �� �������� ResistanceLine �� ������������
-' ���� pDenmarkData.SupportPointsCount < 2, �� �������� SupportLine �� ������������
-
-' ��������� ���������
-    Const QUALIFICATOR_DISABLE As String = "-"
-    Const QUALIFICATOR_ENABLE As String = "Signal"
-    
-    Dim UpQual(1 To 3) As String
-    Dim DownQual(1 To 3) As String
-    Dim UpSignal, DownSignal As Integer
-    Dim i As Integer
-    
-    pDenmarkData.SignalValue = 0
-    UpSignal = 0
-    DownSignal = 0
-    
-    For i = 1 To 3
-        pDenmarkData.Qualificator(i) = QUALIFICATOR_DISABLE
-        UpQual(i) = QUALIFICATOR_DISABLE
-        DownQual(i) = QUALIFICATOR_DISABLE
-    Next i
-    
-' ����������� ����� ��������� � �������������
-    ResLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.ResistancePointCount, _
-        pDenmarkData.ResistanceLine, _
-        pDenmarkData.ResistancePoints, _
-        ClosePrev2, _
-        CloseSucc1
-        
-    SuppLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.SupportPointsCount, _
-        pDenmarkData.SupportLine, _
-        pDenmarkData.SupportPoints, _
-        ClosePrev2, _
-        CloseSucc1
-
-        
-        
-    If pDenmarkData.ResistancePointCount >= 2 Then
-        pDenmarkData.ResistanceAngle = 57.29578 * _
-            Atn(pDenmarkData.ResistanceLine(pPriceData.tC) - _
-                pDenmarkData.ResistanceLine(pPriceData.tC - 1))
-    End If
-    If pDenmarkData.SupportPointsCount >= 2 Then
-        pDenmarkData.SupportAngle = 57.29578 * _
-            Atn(pDenmarkData.SupportLine(pPriceData.tC) - _
-                pDenmarkData.SupportLine(pPriceData.tC - 1))
-    End If
-
-' ������������ ������� ----------------------------------
-    Dim t As Integer
-' 1. ������ ����������� ������: ResistanceLine ��������� � ResistanceLine ������ *************
-    If pDenmarkData.ResistancePointCount >= 2 And pDenmarkData.ResistanceAngle < 0 Then
-'    ����������� ������� ������� �����
-        If pDenmarkData.ResistanceLine(pPriceData.tC) < pPriceData.Cls(pPriceData.tC) Then
-            UpSignal = 1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) > pDenmarkData.ResistanceLine(t) Then
-                    UpSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If UpSignal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) > pPriceData.Cls(pPriceData.tC - 1) Then
-                UpSignal = UpSignal + 1
-                UpQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: open > ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) > pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - demand value < ResistanceLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Lw(pPriceData.tC - 1) < pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-    End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: SupportLine ��������� � SupportLine ������
-    If pDenmarkData.SupportPointsCount >= 2 And pDenmarkData.SupportAngle > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-        If pPriceData.Cls(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-            DownSignal = -1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) < pDenmarkData.SupportLine(t) Then
-                    DownSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If DownSignal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) < pPriceData.Cls(pPriceData.tC - 1) Then
-                DownSignal = DownSignal - 1
-                DownQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: Open ���� ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - supply value(t-1) > SupportLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Hgh(pPriceData.tC - 1) > pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-'    ---------------------------------------------
-    End If
-'      ���������� ������������ ���������
-    If Abs(DownSignal) <> UpSignal Then
-        If Abs(DownSignal) > UpSignal Then
-            pDenmarkData.SignalValue = DownSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = DownQual(i)
-            Next i
-        Else
-            pDenmarkData.SignalValue = UpSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = UpQual(i)
-            Next i
-        End If
-    End If
-End Sub
-
-Sub DetProj(pPriceData As TPriceData, pDenmarkData As TDenmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-    Dim pM As Double, t As Integer, Tm As Integer, tL As Integer
-
-    If pDenmarkData.SignalValue >= 2 Then  ' ������ �������
-
-        tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount)     ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2 Then
-'           t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < ResistanceLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Lw(Tm) ' L(t-1) < ResistanceLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Lw(t) < pM And pPriceData.Lw(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Lw(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
-'               P1( tb) = ResistanceLine(tb) + ResistanceLine(t*) - L(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Lw(Tm)
-            Else
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If ' pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < ResistanceLine(t)}
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Cls(t) < pM And pPriceData.Cls(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue >= 2
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-    If pDenmarkData.SignalValue <= -2 Then
-        tL = pDenmarkData.SupportPoints(pDenmarkData.SupportPointsCount)  ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.SupportPointsCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber = 1 Or pDenmarkData.ProjectNumber = 2 Then
-'           t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > SupportLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Hgh(Tm) ' H(t-1) > SupportLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Hgh(t) > pM And pPriceData.Hgh(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Hgh(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
- '              P1( tb) = SupportLine(tb) + SupportLine(t*) - H(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Hgh(Tm)
-            Else
-'               P2( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  SupportLine(t)}
-'           P3( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pM < pPriceData.Cls(t) And pPriceData.Cls(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue <= -2
-End Sub
-
-Sub ResLine(pP As TPriceData, tE As Integer, ResistancePointCount As Integer, _
-            ResistanceLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� ResistanceLine, dom(ResistanceLine)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(ResistancePointCount)}, s(1) < s(2) < ...< s(ResistancePointCount)
-'   ( s(ResistancePointCount)<= tE )- ������� �����
-' 3) ����� ������� ����� ResistancePointCount.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� SupportLine
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-  
-'1 ����������� ������� �������� �������
-    ResistancePointCount = 0
-    For t = 3 To tE - 1
- '      v = max{high(t-1), high(t+1)} < high(t)}
-        v = pP.Hgh(t - 1)
-        If v < pP.Hgh(t + 1) Then
-            v = pP.Hgh(t + 1)
-        End If
-        IsGoodPoint = pP.Hgh(t) > v
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) < pP.Hgh(t))
-        End If
-        
-        If IsGoodPoint Then       'alt.: v >= High(t + 1)
-            s(ResistancePointCount + 1) = t: ResistancePointCount = ResistancePointCount + 1
-        End If
-    Next t
-    
-loop_:
-    
-    If ResistancePointCount < 2 Then
-        GoTo done
-    End If
-
-' 2 ����������� ����� �������������
-    ResistanceLine(s(1)) = pP.Hgh(s(1))
-    For i = 2 To ResistancePointCount
-        ResistanceLine(s(i)) = pP.Hgh(s(i))
-        v = (pP.Hgh(s(i)) - pP.Hgh(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            ResistanceLine(t) = pP.Hgh(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(ResistancePointCount) < tE Then
-        v = (pP.Hgh(s(ResistancePointCount)) - pP.Hgh(s(ResistancePointCount - 1))) / (s(ResistancePointCount) - s(ResistancePointCount - 1))
-        For t = s(ResistancePointCount) + 1 To tE
-            ResistanceLine(t) = pP.Hgh(s(ResistancePointCount - 1)) + v * (t - s(ResistancePointCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To ResistancePointCount
-            If ResistanceLine(s(t) + 1) < pP.Cls(s(t) + 1) Then
-                ResistancePointCount = ResistancePointCount - 1
-                ' ������� �����
-                For i = t To ResistancePointCount
-                    s(i) = s(i + 1)
-                Next i
-                s(ResistancePointCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(ResistanceLine)
-                Rb = UBound(ResistanceLine)
-                Erase ResistanceLine
-                ReDim ResistanceLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-    
-done:
-End Sub
-
-Sub SuppLine(pP As TPriceData, tE As Integer, SupportPointsCount As Integer, _
-               SupportLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� SupportLine, dom(SupportLine)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(SupportPointsCount)}, s(1) < s(2) < ...< s(SupportPointsCount) -
-'    ������� �����
-' 3) ����� ������� ����� SupportPointsCount.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-    
-'1 ����������� ������� �������� �������
-     SupportPointsCount = 0
-    For t = 3 To tE - 1
-'       v = min{Low(t-1), Low(t+1)} > Low(t)
-        v = pP.Lw(t - 1)
-        If v > pP.Lw(t + 1) Then
-            v = pP.Lw(t + 1)
-        End If
-        
-        IsGoodPoint = pP.Lw(t) < v
-        
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) > pP.Lw(t))
-        End If
-        
-        If IsGoodPoint Then     'alt.: v >= High(t + 1)
-            s(SupportPointsCount + 1) = t: SupportPointsCount = SupportPointsCount + 1
-        End If
-    Next t
-
-loop_:
-    If SupportPointsCount < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� ���������
-    
-    SupportLine(s(1)) = pP.Lw(s(1))
-    For i = 2 To SupportPointsCount
-        SupportLine(s(i)) = pP.Lw(s(i))
-        v = (pP.Lw(s(i)) - pP.Lw(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            SupportLine(t) = pP.Lw(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(1) < tE Then
-        v = (pP.Lw(s(SupportPointsCount)) - pP.Lw(s(SupportPointsCount - 1))) / (s(SupportPointsCount) - s(SupportPointsCount - 1))
-        For t = s(SupportPointsCount) + 1 To tE
-            SupportLine(t) = pP.Lw(s(SupportPointsCount - 1)) + v * (t - s(SupportPointsCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To SupportPointsCount
-            If SupportLine(s(t) + 1) > pP.Cls(s(t) + 1) Then
-                SupportPointsCount = SupportPointsCount - 1
-                ' ������� �����
-                For i = t To SupportPointsCount
-                    s(i) = s(i + 1)
-                Next i
-                s(SupportPointsCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(SupportLine)
-                Rb = UBound(SupportLine)
-                Erase SupportLine
-                ReDim SupportLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-done:
-End Sub
-
-<<<<<<
-======================
-mChart
->>>>>>
-Attribute VB_Name = "mChart"
-Option Explicit
-
-Const CHART_NAME As String = "PriceChart"
-
-Sub Draw_Chart(SignalDefined As Boolean)
-
-    Dim n As Integer
-    Dim theChart As Chart
-    Dim ChartDataAria, szLastNumber As String
-    Dim MinYScale As Double
-    
-    
-    With ThisWorkbook
-' Checking data
-' Disable screen out
-        .Application.Cursor = xlWait
-        .Application.ScreenUpdating = False
-' Create series range
-        n = GetLinesCount(Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE))
-        szLastNumber = n + 1
-        If SignalDefined Then
-            ChartDataAria = "A2:A" + szLastNumber + ",D2:E" + szLastNumber + ",I2:K" + szLastNumber
-        Else
-            ChartDataAria = "A2:A" + szLastNumber + ",D2:E" + szLastNumber + ",I2:J" + szLastNumber
-        End If
-        MinYScale = GetMinValue(.Worksheets(RAW_DATA_SHEET).Range(ChartDataAria))
-' Find and delete old chart
-        .Worksheets(CHART_SHEET).Unprotect
-        Dim WindowWidth, WindowHeight As Integer
-        With .Worksheets(CHART_SHEET)
-            WindowWidth = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            WindowHeight = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-        
-        
-        With .Worksheets(CHART_SHEET).ChartObjects
-            .delete
-            With .Add(5, 5, WindowWidth - 10, WindowHeight - 10)
-                .SendToBack
-                Set theChart = .Chart
-            End With
-' Create a chart
-        End With
-        With theChart
-            .ChartType = xlLine
-            .SetSourceData Source:=Sheets(RAW_DATA_SHEET).Range( _
-                    ChartDataAria), PlotBy:=xlColumns
-            .Location Where:=xlLocationAsObject, name:=CHART_SHEET
-            .HasTitle = True
-            With .ChartTitle
-                .Text = ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE).Value
-                With .Font
-                    .Size = 8
-                    .Bold = True
-                End With
-            End With
-            .HasLegend = True
-            With .Legend
-                .Position = xlTop
-                With .Font
-                    .name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            .HasDataTable = False
-            With .Axes(xlCategory)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                .TickLabels.Orientation = xlUpward
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .CrossesAt = 1
-                .TickLabelSpacing = 1
-                .TickMarkSpacing = 1
-                .AxisBetweenCategories = False
-                .ReversePlotOrder = False
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            With .Axes(xlValue)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .MinimumScale = MinYScale
-                .MaximumScaleIsAuto = True
-                .MinorUnitIsAuto = True
-                .MajorUnitIsAuto = True
-                .Crosses = xlCustom
-                .CrossesAt = MinYScale
-                .ReversePlotOrder = False
-                .ScaleType = xlLinear
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            .ChartTitle.Top = 5
-            .ChartTitle.Left = 5
-            With .Legend
-                .Top = 5
-                .Fill.OneColorGradient _
-                    Style:=msoGradientHorizontal, _
-                    Variant:=3, _
-                    Degree:=0.303913939116503
-                .Fill.Visible = True
-                .Fill.ForeColor.SchemeColor = 71
-            End With
-            .PlotArea.Left = 10
-            .PlotArea.Top = .Legend.Top + .Legend.Height + 5
-            .PlotArea.Width = .ChartArea.Width - 20
-            .PlotArea.Height = .ChartArea.Height - .PlotArea.Top
-            
-' Tune OPEN line
-            With .SeriesCollection(1)
-                .Border.LineStyle = xlNone
-                .MarkerBackgroundColorIndex = xlNone
-                .MarkerForegroundColorIndex = 1
-                .MarkerStyle = xlPlus
-                .Smooth = False
-                .MarkerSize = 9
-                .Shadow = False
-            End With
-' Tune CLOSE line
-            With .SeriesCollection(2)
-                .Border.ColorIndex = 10
-                .Border.Weight = xlMedium
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune RESISTANCE line
-            With .SeriesCollection(3)
-                .Border.ColorIndex = 3
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune SUUPORT line
-            With .SeriesCollection(4)
-                .Border.ColorIndex = 25
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-            If SignalDefined Then
-                With .SeriesCollection(5)
-                    .Border.ColorIndex = 6
-                    .Border.Weight = xlThin
-                    .Border.LineStyle = xlDot
-                End With
-            End If
-        End With
-        .Application.Cursor = xlDefault
-        With .Worksheets(CHART_SHEET)
-            .Range("A1").Select
-            .Protect userInterfaceOnly:=True
-        End With
-    End With
-End Sub
-
-Function GetMinValue(DataRange As Range) As Double
-    Dim Cell As Range
-    Dim MinValue, MaxValue, RangeValue, CorrectValue, Mult As Double
-    MinValue = MAX_PRICE_VALUE
-    MaxValue = MIN_PRICE_VALUE
-    For Each Cell In DataRange
-        If Not IsEmpty(Cell) And IsNumeric(Cell) Then
-            If Cell > MIN_PRICE_VALUE Then
-                If Cell < MinValue Then
-                    MinValue = Cell
-                End If
-                If Cell > MaxValue Then
-                    MaxValue = Cell
-                End If
-            End If
-        End If
-    Next
-    RangeValue = MaxValue - MinValue
-    If RangeValue < 0 Then
-        MinValue = 0
-    Else
-        CorrectValue = RangeValue / 4
-        Mult = MIN_PRICE_VALUE
-        While MinValue - Int(MinValue * Mult) / Mult > CorrectValue
-            Mult = Mult * 10
-        Wend
-        MinValue = Int(MinValue * Mult) / Mult
-    End If
-    GetMinValue = MinValue
-End Function
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{2E6ADAE7-CAA7-454E-97DF-760784AA27A5}{429C004E-8FA7-40D2-BE86-B83C0432EFE0}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mWebQeury
->>>>>>
-Attribute VB_Name = "mWebQeury"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.name = QryName Then
-            WebQuery.delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-Attribute CreateCommandBar.VB_ProcData.VB_Invoke_Func = "R\n14"
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Contents"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 49
-                        .OnAction = "cmHelpContents"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim curdate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    curdate = year * 10000
-    curdate = curdate + month * 100
-    curdate = curdate + day
-    If curdate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mTool
->>>>>>
-Attribute VB_Name = "mTool"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub tool_delete_all_tables()
-    QryDelete ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range("A1")
-End Sub
-
-Sub tool_delete_all_charts(theSheet As Worksheet)
-    Dim theChart As Chart
-    For Each theChart In theSheet
-        theChart.Unprotect
-        theChart.delete
-    Next
-End Sub
-
-Sub DateTimeTest()
-    Dim the_date
-    Dim the_time
-    the_date = DateValue(Now)
-    the_time = TimeValue(Now)
-End Sub
-
-
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{934ECAAF-D9A7-45B4-BB5D-34A0D881DB0A}{9D1622C8-1FA0-4BD4-AE36-4A8180AEBFC3}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.count > 1 Then
-        wbname = Wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            Wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-Private Sub App_NewWorkbook(ByVal Wb As Workbook)
-    MsgBox ("New workbook created. It name is " & Wb.FullName)
-End Sub
-<<<<<<
-======================
-mDataCommands
->>>>>>
-Attribute VB_Name = "mDataCommands"
-Option Explicit
-
-Sub evFileOpen()
-    Dim fileToOpen As String
-    Dim Wb As Workbook
-    Dim ticker As String
-    Dim Result As Integer
-
-    fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
-    Set Wb = ThisWorkbook
-    With Wb
-        If fileToOpen <> "False" Then
-            If .Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = True Then
-                .Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = False
-            End If
-            .Worksheets(FORM_SHEET).Range(FILE_NAME) = fileToOpen
-            Result = UpdateHistoryFromFile(Wb, fileToOpen)
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            
-            ClearResultTables
-            
-            Select Case Result
-                Case FUNCRES_FILE_OK
-                    .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = True
-                    If TDenmark_Calc Then
-                        With .Worksheets(RAW_DATA_SHEET)
-                            ticker = .Range("B1")
-                        End With
-                        With .Worksheets(FORM_SHEET)
-                            .Range("CALC_TICKER_NAME") = ticker
-                        End With
-                    End If
-                Case FUNCRES_FILE_VERY_SMALL
-                    .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_VERY_SMALL
-                    MsgBox MSG_FILE_VERY_SMALL, vbOKOnly, PROGRAM_NAME
-                Case FUNCRES_FILE_INVALID_FORMAT
-                    .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_INVALID_FORMAT
-                    MsgBox MSG_FILE_INVALID_FORMAT, vbOKOnly, PROGRAM_NAME
-                End Select
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-    End With 'wb
-End Sub
-
-Sub evSubmit_Click()
-    Dim ticker As String
-
-    Application.Cursor = xlWait
-    Dim Wb As Workbook
-    Set Wb = ThisWorkbook
-    With Wb
-        With .Worksheets(VAR_SHEET)
-            ticker = .Range("DEN_SYMBOL")
-            If .Range("BOOL_DATA_READY") = False Or .Range("BOOL_LOAD_DATA") = True Then
-                .Range("BOOL_DATA_READY") = UpdateHistoryFromWeb(Wb)
-            End If
-            .Range("BOOL_DEMARK_READY") = False
-        End With
-        If TDenmark_Calc Then
-            With .Worksheets(FORM_SHEET)
-                .Range("CALC_TICKER_NAME") = ticker
-                .Range("FILE_NAME") = ""
-            End With
-        End If
-    End With
-    Application.Cursor = xlDefault
-End Sub
-
-Sub evTicker_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SECNAME") = .Range("IDX_DEN_SYMBOL")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evSecName_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SYMBOL") = .Range("IDX_DEN_SECNAME")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evHistory_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_DATA_READY") = False
-    End With
-End Sub
-
-Sub evGroupChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        GroupIdx = .Range("IDX_DEN_LIST")
-        .Range("IDX_DEN_SYMBOL") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat.ListFillRange = NewCbxRange
-        NewRangeOffsetCol = NewRangeOffsetCol + 1
-        NewCbxRange = .name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat.ListFillRange = NewCbxRange
-    End With
-    evTicker_Change
-End Sub
-
-Sub evUpdateTickerList()
-    UpdateTickerList ThisWorkbook
-    evHistory_Change
-End Sub
-<<<<<<
-======================
-mGetFileData
->>>>>>
-Attribute VB_Name = "mGetFileData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Public Const MAX_LOAD_DATA_LINES As Integer = 16000
-
-Public Const MSG_FILE_VERY_SMALL As String = "� ����� ������������ ������"
-Public Const MSG_FILE_INVALID_FORMAT As String = "�������� ������ �����"
-
-Public Const FUNCRES_FILE_OK As Integer = 0
-Public Const FUNCRES_FILE_VERY_SMALL As Integer = -1
-Public Const FUNCRES_FILE_INVALID_FORMAT As Integer = -2
-
-Function UpdateHistoryFromFile(Wb As Workbook, fileToOpen As String) As Integer
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    Dim SingleFileLine As String
-    Dim FileHandler As Integer
-    Dim i, j, row_idx As Integer
-    
-    UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-    With Wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = True
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            'Clear table include temp area
-            .Parent.Application.DisplayAlerts = False
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            
-            ' Reading data from file
-            FileHandler = FreeFile
-            row_idx = 0
-            Open fileToOpen For Input As #FileHandler
-            Do While Not EOF(FileHandler) And row_idx < MAX_LOAD_DATA_LINES
-                Line Input #FileHandler, SingleFileLine
-                .Range(PRICE_TABLE).Offset(row_idx, 0) = SingleFileLine
-                row_idx = row_idx + 1
-            Loop
-            Close #FileHandler
-            
-            ' Parsing data
-            DestRangeName = "=" & RAW_DATA_SHEET & "!$B$1:$B" & row_idx
-            ResultLength = row_idx
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-            .Parent.Application.DisplayAlerts = True
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            
-            If Not CheckFileFormat(RawData.Offset(-1, 0)) Then
-                UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-                Exit Function
-            End If
-            
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).delete xlShiftUp
-            Else
-                UpdateHistoryFromFile = FUNCRES_FILE_VERY_SMALL
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromFile = FUNCRES_FILE_OK
-End Function
-
-Function CheckFileFormat(HeaderString As Range) As Boolean
-    With HeaderString
-        CheckFileFormat = _
-            .Offset(0, DATE_IDX) = "Date" And _
-            .Offset(0, TIME_IDX) = "Time" And _
-            .Offset(0, OPEN_IDX) = "Open" And _
-            .Offset(0, CLOSE_IDX) = "Close" And _
-            .Offset(0, LOW_IDX) = "Low" And _
-            .Offset(0, HIGH_IDX) = "High" And _
-            .Offset(0, VOLUME_IDX) = "Volume"
-    End With
-End Function
-<<<<<<
-Project Name : 'Denmark_method'
-Quirk - duff tag length======================
-MGetWebData
->>>>>>
-Attribute VB_Name = "MGetWebData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Const QueryDataName As String = "ExternalDenmarkData"
-
-Function UpdateHistoryFromWeb(wb As Workbook) As Boolean
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    UpdateHistoryFromWeb = False
-    QryPathStr = GetQryPath(wb)
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = IsNumeric(.Range("DEN_TIME"))
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table include temp area
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-    
-    '        .Parent.Application.DisplayAlerts = False
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-    '        .Parent.Application.DisplayAlerts = True
-            Dim i, j, row_idx As Integer
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).delete xlShiftUp
-            Else
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).delete xlShiftUp
-                End If
-            Else
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = "'" & Location.Cells(1 + row_idx, 1)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And TimeValue(Now) < TimeSerial(18, 0, 0)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromWeb = True
-End Function
-
-Private Function GetQryPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    Dim IsIntradai As Boolean
-    Dim DayCount As Integer
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/online/nph-single-old.cgi?"
-        QryPathStr = QryPathStr & "ticker=" & .Range("DEN_SYMBOL")
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        IsIntradai = IsNumeric(.Range("DEN_TIME"))
-        If IsIntradai Then
-            QryPathStr = QryPathStr & "&period=" & .Range("DEN_TIME")
-        Else
-            QryPathStr = QryPathStr & "&period=60"
-        End If
-        QryPathStr = QryPathStr & "&oh=11&ch=18"
-        QryPathStr = QryPathStr & "&separator=%2C"
-        QryPathStr = QryPathStr & "&vmode=Ignore&vtype=BA2"
-        QryPathStr = QryPathStr & "&format=Excel"
-        
-        If IsIntradai Then
-            DayCount = .Range("DEN_HISTORY") * .Range("DEN_TIME") \ 420 + 1 + .Range("DEN_HISTORY")
-        Else
-            DayCount = .Range("DEN_HISTORY")
-        End If
-        QryPathStr = QryPathStr & "&daysback=" & DayCount
-'        .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-    
-End Function
-
-Sub UpdateTickerList(wb As Workbook)
-    Dim Idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    QryPathStr = GetListPath(wb)
-    With wb
-        With .Worksheets(VAR_SHEET)
-            Idx = .Range("IDX_DEN_LIST")
-            Set Location = .Range("TICKER_TABLES").Offset(0, (Idx - 1) * 2)
-             .Range("IDX_DEN_SYMBOL") = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            ' Remove header
-            ' Find [DATA]
-            n = 0
-            Do While Location.Offset(n, 0) <> "[DATA]"
-                n = n + 1
-            Loop
-            .Range(Location.Offset(1, 0), Location.Offset(n, 1)).delete Shift:=xlUp
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-        
-        '        .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 0), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-        ' Setup Ticker List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        ' Setup Name List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Offset(0, 1).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-    End With
-End Sub
-
-Private Function GetListPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/names.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        QryPathStr = QryPathStr & "&category=STOCKS"
-        '.Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            ThisWorkbook.Save
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(FORM_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mReadWrite
->>>>>>
-Attribute VB_Name = "mReadWrite"
-Option Explicit
-
-Public Const GOOD_LINE_STATUS As String = "Ok"
-Public Const BAD_LINE_STATUS As String = "N/A"
-
-Function ReadPricesData(Location As Range, Hist As Integer, dt As Integer, _
-              pPriceData As TPriceData) As Integer
-    '������������� ���� TPriceData �� ������� ���� - 1
-    'k��������� �� ����� ��� hist ��������� �����
-    'aPoint - ������ �������
-    '������ ��� ������ ������� �������������� ������ (������)
-    Dim n, i As Integer
-    
-    '����������� ����� ����� ������� - n
-    n = GetLinesCount(Location)
-    ReadPricesData = n
-    If n < 9 Then             '���������� ������ !!!
-        GoTo done
-    End If
-    ' ����� ����� ���������� ()
-    If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-        Hist = (n - 3) \ dt + 1 '
-    End If
-    Dim t, s As Integer
-    For t = 0 To Hist - 1
-        s = n - t * dt - 1
-        pPriceData.D(Hist - t) = Location.Offset(s, DATE_IDX).Value
-        pPriceData.Tm(Hist - t) = Location.Offset(s, TIME_IDX).Value
-        pPriceData.Opn(Hist - t) = Location.Offset(s, OPEN_IDX).Value
-        pPriceData.Hgh(Hist - t) = Location.Offset(s, HIGH_IDX).Value
-        pPriceData.Lw(Hist - t) = Location.Offset(s, LOW_IDX).Value
-        pPriceData.Cls(Hist - t) = Location.Offset(s, CLOSE_IDX).Value
-        pPriceData.Vl(Hist - t) = Location.Offset(s, VOLUME_IDX).Value
-    Next t
-    ReadPricesData = t + 1
-done:
-End Function
-
-Sub ResultLinesOut(Location As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim n As Integer
-    
-    n = GetLinesCount(Location)
-    With Location
-        .Offset(-1, RESIST_IDX) = "Resistance"
-        .Offset(-1, SUPPORT_IDX) = "Support"
-        .Offset(-1, PROJECT_IDX) = "Project"
-    End With
-    Dim t, count, Idx, loc_idx As Integer
-    count = pPD.tC
-    For t = 0 To count - 1
-        Idx = count - t
-        loc_idx = n - t - 1
-        If pDen.ResistanceLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, RESIST_IDX).Value = pDen.ResistanceLine(Idx)
-        End If
-        If pDen.SupportLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, SUPPORT_IDX).Value = pDen.SupportLine(Idx)
-        End If
-        If Abs(pDen.SignalValue) > 1 Then
-            Location.Offset(loc_idx, PROJECT_IDX).Value = pDen.ProjectPrice
-        End If
-    Next t
-End Sub
-
-Sub Out_Table_1(TheRange As Range, pDen As TDenmark, LastIdx As Integer)
-    
-    
-    ' Col = 2 - �� ��������� !!!
-    ' Status - Col = 0
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(0, 0).Value = BAD_LINE_STATUS
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(1, 0).Value = BAD_LINE_STATUS
-    End If
-    ' -----------------------------------------
-    ' ���� �������� ����� ������������� � ��������� - Col = 1
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 1).Value = pDen.ResistanceAngle
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 1).Value = pDen.SupportAngle
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 1).Value = (pDen.ResistanceAngle + pDen.SupportAngle) / 2
-    End If
-    ' -----------------------------------------
-    ' ������� ���� ����� �������� �� ������� ������
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 2).Value = pDen.ResistanceLine(LastIdx)
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 2).Value = pDen.SupportLine(LastIdx)
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 2).Value = _
-            (pDen.ResistanceLine(LastIdx) + pDen.SupportLine(LastIdx)) / 2
-    End If
-    
-End Sub
-
-Sub Out_Table_2(TheRange As Range, TheComment As Range, pPD As TPriceData, pDen As TDenmark)
-    Const ColorIndexBUY = 5
-    Const ColorIndexSELL = 3
-    Const ColorIndexNOTHINK = 14
-    
-    Dim SignalValue_defined, allert_enable  As Boolean
-    Dim Message As String
-    SignalValue_defined = False
-    allert_enable = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_ALLERT_DLG")
-    Message = "������ �� ��������� ������ �� ���������������."
-    If pDen.SignalValue >= 2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "BUY"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexBUY
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue - 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "BUY Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & pDen.SignalValue - 1 & " ! "
-    End If
-    If pDen.SignalValue <= -2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "SELL"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexSELL
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue + 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "SELL Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(pDen.SignalValue + 1) & "!"
-    End If
-    With TheComment
-        .Value = Message
-        .Font.Bold = True
-        Dim color_idx As Integer
-        If SignalValue_defined Then
-            If pDen.SignalValue > 0 Then
-                .Font.ColorIndex = ColorIndexBUY
-            Else
-                .Font.ColorIndex = ColorIndexSELL
-            End If
-        Else
-            .Font.ColorIndex = ColorIndexNOTHINK
-        End If
-    End With
-    If allert_enable And SignalValue_defined Then
-        MsgBox _
-            Prompt:=Message, _
-            Title:=PROGRAM_NAME, _
-            Buttons:=vbOKOnly + vbInformation
-    End If
-End Sub
-
-Sub Out_Table_3(TheRange As Range, pDen As TDenmark)
-    Dim i As Integer
-    For i = 1 To 3
-        TheRange.Offset(i - 1, 0).Value = pDen.Qualificator(i)
-    Next i
-End Sub
-
-Sub Out_Table_4(TheRange As Range, pPD As TPriceData)
-    Dim LastIdx As Integer
-    LastIdx = pPD.tC
-    With TheRange
-        .Offset(0, 0).Value2 = "'" & pPD.D(LastIdx)
-        .Offset(0, 1).Value2 = "'" & pPD.Tm(LastIdx)
-        .Offset(0, 2) = pPD.Opn(LastIdx)
-        .Offset(0, 3) = pPD.Hgh(LastIdx)
-        .Offset(0, 4) = pPD.Lw(LastIdx)
-        .Offset(0, 5) = pPD.Cls(LastIdx)
-        .Offset(0, 6) = pPD.Cls(LastIdx) - pPD.Cls(LastIdx - 1)
-    End With
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Denmark method bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-    End With
-    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(wb As Workbook)
-    With wb
-        .Application.ScreenUpdating = False
-        
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(FORM_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-            .Select
-        End With
-        With .Worksheets(CHART_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-        End With
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(wb As Workbook)
-    With wb
-        .Unprotect
-        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Unprotect
-        End With
-        With .Worksheets(FORM_SHEET)
-            .Select
-            .Unprotect
-        End With
-        .Application.ScreenUpdating = True
-        
-    End With
-End Sub
-
-<<<<<<
-======================
-mTypes
->>>>>>
-Attribute VB_Name = "mTypes"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "����� �-�� �������"
-Public Const PROGRAM_VERSION As String = "version 3.0 Professional"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-'Public Const ESTIMATION_DATE As Long = 19980915
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "J27"
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const PRICE_TABLE As String = "B1"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-Public Const VAR_SHEET As String = "Var_s"
-
-Public Const CHART_SHEET As String = "Chart"
-
-Public Const MIN_PRICE_VALUE As Double = 0.000001
-Public Const MAX_PRICE_VALUE As Double = 1000000000
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const CLOSE_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const HIGH_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const RESIST_IDX As Integer = 7
-Public Const SUPPORT_IDX As Integer = 8
-Public Const PROJECT_IDX As Integer = 9
-
-Public Const DATE_STAMP_OFFSET = PROJECT_IDX + 1
-Public Const TIME_STAMP_OFFSET = PROJECT_IDX + 4
-Public Const DATE_TIME_STAMP_SIZE = 5
-
-Type TPriceData
-    D() As String      ' ����������� ����
-    Tm() As String     ' �����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Double     ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type TDenmark
-   ResistanceLine() As Double           'Resistance line
-   ResistancePoints() As Integer        'Resistance pivot points
-   ResistancePointCount As Integer      'The number of resistance pivot points
-   ResistanceAngle As Double            'Angle of Declination of ResistanceLine
-   
-   SupportLine() As Double              'Support line
-   SupportPoints() As Integer           'Support pivot points
-   SupportPointsCount As Integer        'The number of support pivot points
-   SupportAngle As Double               ' Angle of Declination of SupportLine
-   
-   SignalParameter     As Integer       ' parameter for SignalValue
-   SignalValue      As Integer          'SignalValue
-   
-   
-   Qualificator(1 To 3) As String       ' qualificators
- 
-   ProjectNumber As Integer             ' ����� ��������
-   ProjectPrice  As Double              ' �������� ����
-   
-End Type
-
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-Dim AppRunEnable As New cEnableRun
-
-Sub evParamChange()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-End Sub
-
-Sub cmViewChart(Optional SwapPage As Boolean = True)
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_CHART_READY") = False
-        If .Range("BOOL_DEMARK_READY") <> True Then
-            If .Range("BOOL_AUTORECALC") = True Then
-                evSubmit_Click
-                If .Range("BOOL_DEMARK_READY") <> True Then
-                    Exit Sub
-                End If
-            Else
-                MsgBox _
-                    "������ �� ����� ���� ��������." & vbCrLf & "�������� ������ �� ����������.", _
-                    vbOKOnly + vbExclamation, _
-                    PROGRAM_NAME
-                Exit Sub
-            End If
-        End If
-    End With
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        With .Range("TABLE_1")
-            Dim test_lines As Boolean
-            test_lines = StrComp(.Cells(1, 1).Value, GOOD_LINE_STATUS)
-            test_lines = test_lines + StrComp(.Cells(2, 1).Value, GOOD_LINE_STATUS)
-            If test_lines <> 0 Then
-                MsgBox _
-                    Prompt:="������ �� ����� ���� ��������." & vbCrLf & "������� ����� �� ���������� .", _
-                    Title:=PROGRAM_NAME, _
-                    Buttons:=vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End With
-        Draw_Chart Not IsEmpty(.Range("TABLE_2").Cells(1, 1))
-    End With
-    With ThisWorkbook
-        .Worksheets(VAR_SHEET).Range("BOOL_CHART_READY") = True
-        If SwapPage Then
-            .Worksheets(CHART_SHEET).Select
-        End If
-    End With
-End Sub
-
-Sub cmViewForm()
-    With ThisWorkbook
-        .Worksheets(FORM_SHEET).Select
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Dim ResistanceLine
-    ResistanceLine = MsgBox( _
-        Prompt:="�� ������� ��������� ���������?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If ResistanceLine = vbYes Then
-       Application.Quit
-    End If
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Demark.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable wb:=ThisWorkbook
-    SetEnvironment wb:=ThisWorkbook
-    ProtectionEnable wb:=ThisWorkbook
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable wb:=ThisWorkbook
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=True
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmPrint()
-    If MsgBox( _
-            Prompt:="�� ������� ����������� ���������?", _
-            Buttons:=vbYesNo + vbQuestion, _
-            Title:=PROGRAM_NAME) = vbNo _
-    Then
-        Exit Sub
-    End If
-    Dim s_ticker, s_name, s_time As String
-    s_ticker = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME")
-    s_name = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_NAME")
-    s_time = Now
-    Application.ScreenUpdating = False
-    cmViewChart SwapPage:=False
-    Application.ScreenUpdating = False
-    With ThisWorkbook.Worksheets(FORM_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    With ThisWorkbook.Worksheets(CHART_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    Application.ScreenUpdating = False
-    ThisWorkbook.Worksheets(Array("MainForm", "Chart")).PrintOut Copies:=1, Collate:=True
-    cmViewForm
-End Sub
-<<<<<<
-======================
-mDemark
->>>>>>
-Attribute VB_Name = "mDemark"
-Option Explicit
-
-Public Const FORM_SHEET As String = "MainForm"
-
-'Form Ranges
-Public Const FILE_NAME As String = "FILE_NAME"
-Public Const TABLE_1 As String = "TABLE_1"
-Public Const TABLE_2 As String = "TABLE_2"
-Public Const TABLE_3 As String = "TABLE_3"
-Public Const TABLE_4 As String = "TABLE_4"
-Public Const TABLE_COMMENT As String = "TABLE_COMMENT"
-
-'�������� ��� ������ - �������� 1
-
-'*********************
-Dim PriceDataArray As TPriceData
-Dim DenmarkDataArray As TDenmark
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Sub ClearResultTables()
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        .Range(TABLE_1).ClearContents ' �������-1
-        .Range(TABLE_2).ClearContents ' �������-2
-        .Range(TABLE_3).ClearContents ' �������-3
-        .Range(TABLE_COMMENT).Value = "" ' ����������-3
-        .Range(TABLE_4).ClearContents ' �������-4
-    End With
-End Sub
-
-Function TDenmark_Calc() As Boolean
-    
-    Dim nWindow As Integer
-    Dim bPrevCloseFilter, bSuccCloseFilter As Boolean
-    
-    TDenmark_Calc = False
-    
-    mobjAppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-'1)    Read User data
-        With .Worksheets(VAR_SHEET)
-            DenmarkDataArray.ProjectNumber = .Range("DEN_PROECT").Value
-            DenmarkDataArray.SignalParameter = .Range("DEN_PARAM").Value
-            nWindow = .Range("DEN_WINDOW").Value
-            bPrevCloseFilter = .Range("BOOL_PREV_CLOSE").Value
-            bSuccCloseFilter = .Range("BOOL_SUCC_CLOSE").Value
-        End With
-
-'2)   Memory allocation
-        allocate_memory PriceDataArray, DenmarkDataArray, nWindow
-
-'3)   Read data
-        Dim TheRange As Range
-        Set TheRange = .Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE)
-        Dim LinesCount As Integer
-        LinesCount = ReadPricesData(Location:=TheRange, Hist:=PriceDataArray.tC, dt:=1, pPriceData:=PriceDataArray)
-        
-        'Init function result
-        TDenmark_Calc = LinesCount >= nWindow
-        
-        If LinesCount >= nWindow Then
-        
-'4)   Calculate metod TDenmarkDataArray
-            DetDenmark PriceDataArray, DenmarkDataArray, bPrevCloseFilter, bSuccCloseFilter
-            If Abs(DenmarkDataArray.SignalValue) > 1 Then  '������� ���������, ���� ���� ������
-                DetProj PriceDataArray, DenmarkDataArray
-            End If
-'5)   Write result
-            Application.ScreenUpdating = False
-    
-'6)    Clear interface tables
-            ClearResultTables
-            
-            ResultLinesOut Location:=TheRange.Offset(2, 0), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-            
-            With .Worksheets(FORM_SHEET)
-                Out_Table_1 TheRange:=.Range(TABLE_1).Cells(1, 1), pDen:=DenmarkDataArray, LastIdx:=PriceDataArray.tC
-                Out_Table_2 _
-                        TheRange:=.Range(TABLE_2).Cells(1, 1), _
-                        TheComment:=.Range("TABLE_COMMENT"), _
-                        pPD:=PriceDataArray, _
-                        pDen:=DenmarkDataArray
-                Out_Table_3 TheRange:=.Range(TABLE_3).Cells(1, 1), pDen:=DenmarkDataArray
-                Out_Table_4 TheRange:=.Range(TABLE_4).Cells(1, 1), pPD:=PriceDataArray
-                With .Range(TABLE_1)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_2)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_3)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_4)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-            End With
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = True
-        Else
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-'7)   Free unused memory
-        free_unused_memory PriceDataArray, DenmarkDataArray
-    End With
-End Function
-
-Sub allocate_memory(pPriceData As TPriceData, pDenmarkData As TDenmark, memsize As Integer)
-'  ������ ��� TDenmark
-    ReDim pDenmarkData.ResistanceLine(1 To memsize)
-    ReDim pDenmarkData.ResistancePoints(1 To memsize)
-    ReDim pDenmarkData.SupportLine(1 To memsize)
-    ReDim pDenmarkData.SupportPoints(1 To memsize)
-   
-' ������������� ������ �� �����
-    pPriceData.tC = memsize
-    ReDim pPriceData.D(1 To memsize)
-    ReDim pPriceData.Tm(1 To memsize)
-    ReDim pPriceData.Opn(1 To memsize)
-    ReDim pPriceData.Hgh(1 To memsize)
-    ReDim pPriceData.Lw(1 To memsize)
-    ReDim pPriceData.Cls(1 To memsize)
-    ReDim pPriceData.Vl(1 To memsize)
-
-End Sub
-
-Sub free_unused_memory(pP As TPriceData, pD As TDenmark)
-'   Free Prices
-    pP.tC = 0
-    Erase pP.D
-    Erase pP.Tm
-    Erase pP.Opn
-    Erase pP.Hgh
-    Erase pP.Lw
-    Erase pP.Cls
-    Erase pP.Vl
-    
-'Free TDenmark
-    Erase pD.ResistanceLine
-    Erase pD.ResistancePoints
-    Erase pD.SupportLine
-    Erase pD.SupportPoints
-End Sub
-
-
-'*****************************************
-Sub DetDenmark(pPriceData As TPriceData, pDenmarkData As TDenmark, ByVal ClosePrev2 As Boolean, ByVal CloseSucc1 As Boolean)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPriceData  - ����, ����������� ����� ������ �� ����� (����������)
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' pDenmarkData - �������� ������ �������� (������ ��������, SignalParameter - ���������):
-' ����� ResistanceLine,SupportLine �� �������, ������� �����, ������� � ������� ��� �������
-' SignalValue = 0 ������ �����������
-' SignalValue < 0 ������ ����������� ������ (������ �������)
-' SignalValue > 0 ������ ����������� ������ (������ �������)
-' ���� pDenmarkData.ResistancePointCount < 2, �� �������� ResistanceLine �� ������������
-' ���� pDenmarkData.SupportPointsCount < 2, �� �������� SupportLine �� ������������
-
-' ��������� ���������
-    Const QUALIFICATOR_DISABLE As String = "-"
-    Const QUALIFICATOR_ENABLE As String = "Signal"
-    
-    Dim UpQual(1 To 3) As String
-    Dim DownQual(1 To 3) As String
-    Dim UpSignal, DownSignal As Integer
-    Dim i As Integer
-    
-    pDenmarkData.SignalValue = 0
-    UpSignal = 0
-    DownSignal = 0
-    
-    For i = 1 To 3
-        pDenmarkData.Qualificator(i) = QUALIFICATOR_DISABLE
-        UpQual(i) = QUALIFICATOR_DISABLE
-        DownQual(i) = QUALIFICATOR_DISABLE
-    Next i
-    
-' ����������� ����� ��������� � �������������
-    ResLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.ResistancePointCount, _
-        pDenmarkData.ResistanceLine, _
-        pDenmarkData.ResistancePoints, _
-        ClosePrev2, _
-        CloseSucc1
-        
-    SuppLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.SupportPointsCount, _
-        pDenmarkData.SupportLine, _
-        pDenmarkData.SupportPoints, _
-        ClosePrev2, _
-        CloseSucc1
-
-        
-        
-    If pDenmarkData.ResistancePointCount >= 2 Then
-        pDenmarkData.ResistanceAngle = 57.29578 * _
-            Atn(pDenmarkData.ResistanceLine(pPriceData.tC) - _
-                pDenmarkData.ResistanceLine(pPriceData.tC - 1))
-    End If
-    If pDenmarkData.SupportPointsCount >= 2 Then
-        pDenmarkData.SupportAngle = 57.29578 * _
-            Atn(pDenmarkData.SupportLine(pPriceData.tC) - _
-                pDenmarkData.SupportLine(pPriceData.tC - 1))
-    End If
-
-' ������������ ������� ----------------------------------
-    Dim t As Integer
-' 1. ������ ����������� ������: ResistanceLine ��������� � ResistanceLine ������ *************
-    If pDenmarkData.ResistancePointCount >= 2 And pDenmarkData.ResistanceAngle < 0 Then
-'    ����������� ������� ������� �����
-        If pDenmarkData.ResistanceLine(pPriceData.tC) < pPriceData.Cls(pPriceData.tC) Then
-            UpSignal = 1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) > pDenmarkData.ResistanceLine(t) Then
-                    UpSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If UpSignal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) > pPriceData.Cls(pPriceData.tC - 1) Then
-                UpSignal = UpSignal + 1
-                UpQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: open > ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) > pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - demand value < ResistanceLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Lw(pPriceData.tC - 1) < pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-    End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: SupportLine ��������� � SupportLine ������
-    If pDenmarkData.SupportPointsCount >= 2 And pDenmarkData.SupportAngle > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-        If pPriceData.Cls(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-            DownSignal = -1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) < pDenmarkData.SupportLine(t) Then
-                    DownSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If DownSignal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) < pPriceData.Cls(pPriceData.tC - 1) Then
-                DownSignal = DownSignal - 1
-                DownQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: Open ���� ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - supply value(t-1) > SupportLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Hgh(pPriceData.tC - 1) > pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-'    ---------------------------------------------
-    End If
-'      ���������� ������������ ���������
-    If Abs(DownSignal) <> UpSignal Then
-        If Abs(DownSignal) > UpSignal Then
-            pDenmarkData.SignalValue = DownSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = DownQual(i)
-            Next i
-        Else
-            pDenmarkData.SignalValue = UpSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = UpQual(i)
-            Next i
-        End If
-    End If
-End Sub
-
-Sub DetProj(pPriceData As TPriceData, pDenmarkData As TDenmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-    Dim pM As Double, t As Integer, Tm As Integer, tL As Integer
-
-    If pDenmarkData.SignalValue >= 2 Then  ' ������ �������
-
-        tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount)     ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2 Then
-'           t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < ResistanceLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Lw(Tm) ' L(t-1) < ResistanceLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Lw(t) < pM And pPriceData.Lw(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Lw(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
-'               P1( tb) = ResistanceLine(tb) + ResistanceLine(t*) - L(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Lw(Tm)
-            Else
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If ' pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < ResistanceLine(t)}
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Cls(t) < pM And pPriceData.Cls(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue >= 2
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-    If pDenmarkData.SignalValue <= -2 Then
-        tL = pDenmarkData.SupportPoints(pDenmarkData.SupportPointsCount)  ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.SupportPointsCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber = 1 Or pDenmarkData.ProjectNumber = 2 Then
-'           t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > SupportLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Hgh(Tm) ' H(t-1) > SupportLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Hgh(t) > pM And pPriceData.Hgh(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Hgh(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
- '              P1( tb) = SupportLine(tb) + SupportLine(t*) - H(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Hgh(Tm)
-            Else
-'               P2( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  SupportLine(t)}
-'           P3( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pM < pPriceData.Cls(t) And pPriceData.Cls(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue <= -2
-End Sub
-
-Sub ResLine(pP As TPriceData, tE As Integer, ResistancePointCount As Integer, _
-            ResistanceLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� ResistanceLine, dom(ResistanceLine)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(ResistancePointCount)}, s(1) < s(2) < ...< s(ResistancePointCount)
-'   ( s(ResistancePointCount)<= tE )- ������� �����
-' 3) ����� ������� ����� ResistancePointCount.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� SupportLine
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-  
-'1 ����������� ������� �������� �������
-    ResistancePointCount = 0
-    For t = 3 To tE - 1
- '      v = max{high(t-1), high(t+1)} < high(t)}
-        v = pP.Hgh(t - 1)
-        If v < pP.Hgh(t + 1) Then
-            v = pP.Hgh(t + 1)
-        End If
-        IsGoodPoint = pP.Hgh(t) > v
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) < pP.Hgh(t))
-        End If
-        
-        If IsGoodPoint Then       'alt.: v >= High(t + 1)
-            s(ResistancePointCount + 1) = t: ResistancePointCount = ResistancePointCount + 1
-        End If
-    Next t
-    
-loop_:
-    
-    If ResistancePointCount < 2 Then
-        GoTo done
-    End If
-
-' 2 ����������� ����� �������������
-    ResistanceLine(s(1)) = pP.Hgh(s(1))
-    For i = 2 To ResistancePointCount
-        ResistanceLine(s(i)) = pP.Hgh(s(i))
-        v = (pP.Hgh(s(i)) - pP.Hgh(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            ResistanceLine(t) = pP.Hgh(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(ResistancePointCount) < tE Then
-        v = (pP.Hgh(s(ResistancePointCount)) - pP.Hgh(s(ResistancePointCount - 1))) / (s(ResistancePointCount) - s(ResistancePointCount - 1))
-        For t = s(ResistancePointCount) + 1 To tE
-            ResistanceLine(t) = pP.Hgh(s(ResistancePointCount - 1)) + v * (t - s(ResistancePointCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To ResistancePointCount
-            If ResistanceLine(s(t) + 1) < pP.Cls(s(t) + 1) Then
-                ResistancePointCount = ResistancePointCount - 1
-                ' ������� �����
-                For i = t To ResistancePointCount
-                    s(i) = s(i + 1)
-                Next i
-                s(ResistancePointCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(ResistanceLine)
-                Rb = UBound(ResistanceLine)
-                Erase ResistanceLine
-                ReDim ResistanceLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-    
-done:
-End Sub
-
-Sub SuppLine(pP As TPriceData, tE As Integer, SupportPointsCount As Integer, _
-               SupportLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� SupportLine, dom(SupportLine)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(SupportPointsCount)}, s(1) < s(2) < ...< s(SupportPointsCount) -
-'    ������� �����
-' 3) ����� ������� ����� SupportPointsCount.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-    
-'1 ����������� ������� �������� �������
-     SupportPointsCount = 0
-    For t = 3 To tE - 1
-'       v = min{Low(t-1), Low(t+1)} > Low(t)
-        v = pP.Lw(t - 1)
-        If v > pP.Lw(t + 1) Then
-            v = pP.Lw(t + 1)
-        End If
-        
-        IsGoodPoint = pP.Lw(t) < v
-        
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) > pP.Lw(t))
-        End If
-        
-        If IsGoodPoint Then     'alt.: v >= High(t + 1)
-            s(SupportPointsCount + 1) = t: SupportPointsCount = SupportPointsCount + 1
-        End If
-    Next t
-
-loop_:
-    If SupportPointsCount < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� ���������
-    
-    SupportLine(s(1)) = pP.Lw(s(1))
-    For i = 2 To SupportPointsCount
-        SupportLine(s(i)) = pP.Lw(s(i))
-        v = (pP.Lw(s(i)) - pP.Lw(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            SupportLine(t) = pP.Lw(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(1) < tE Then
-        v = (pP.Lw(s(SupportPointsCount)) - pP.Lw(s(SupportPointsCount - 1))) / (s(SupportPointsCount) - s(SupportPointsCount - 1))
-        For t = s(SupportPointsCount) + 1 To tE
-            SupportLine(t) = pP.Lw(s(SupportPointsCount - 1)) + v * (t - s(SupportPointsCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To SupportPointsCount
-            If SupportLine(s(t) + 1) > pP.Cls(s(t) + 1) Then
-                SupportPointsCount = SupportPointsCount - 1
-                ' ������� �����
-                For i = t To SupportPointsCount
-                    s(i) = s(i + 1)
-                Next i
-                s(SupportPointsCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(SupportLine)
-                Rb = UBound(SupportLine)
-                Erase SupportLine
-                ReDim SupportLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-done:
-End Sub
-
-<<<<<<
-======================
-mChart
->>>>>>
-Attribute VB_Name = "mChart"
-Option Explicit
-
-Const CHART_NAME As String = "PriceChart"
-
-Sub Draw_Chart(SignalDefined As Boolean)
-
-    Dim n As Integer
-    Dim theChart As Chart
-    Dim ChartDataAria, szLastNumber As String
-    Dim MinYScale As Double
-    
-    
-    With ThisWorkbook
-' Checking data
-' Disable screen out
-        .Application.Cursor = xlWait
-        .Application.ScreenUpdating = False
-' Create series range
-        n = GetLinesCount(Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE))
-        szLastNumber = n + 1
-        If SignalDefined Then
-            ChartDataAria = "A2:A" + szLastNumber + ",D2:E" + szLastNumber + ",I2:K" + szLastNumber
-        Else
-            ChartDataAria = "A2:A" + szLastNumber + ",D2:E" + szLastNumber + ",I2:J" + szLastNumber
-        End If
-        MinYScale = GetMinValue(.Worksheets(RAW_DATA_SHEET).Range(ChartDataAria))
-' Find and delete old chart
-        .Worksheets(CHART_SHEET).Unprotect
-        Dim WindowWidth, WindowHeight As Integer
-        With .Worksheets(CHART_SHEET)
-            WindowWidth = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            WindowHeight = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-        
-        
-        With .Worksheets(CHART_SHEET).ChartObjects
-            .delete
-            With .Add(5, 5, WindowWidth - 10, WindowHeight - 10)
-                .SendToBack
-                Set theChart = .Chart
-            End With
-' Create a chart
-        End With
-        With theChart
-            .ChartType = xlLine
-            .SetSourceData Source:=Sheets(RAW_DATA_SHEET).Range( _
-                    ChartDataAria), PlotBy:=xlColumns
-            .Location Where:=xlLocationAsObject, name:=CHART_SHEET
-            .HasTitle = True
-            With .ChartTitle
-                .Text = ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE).Value
-                With .Font
-                    .Size = 8
-                    .Bold = True
-                End With
-            End With
-            .HasLegend = True
-            With .Legend
-                .Position = xlTop
-                With .Font
-                    .name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            .HasDataTable = False
-            With .Axes(xlCategory)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                .TickLabels.Orientation = xlUpward
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .CrossesAt = 1
-                .TickLabelSpacing = 1
-                .TickMarkSpacing = 1
-                .AxisBetweenCategories = False
-                .ReversePlotOrder = False
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            With .Axes(xlValue)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .MinimumScale = MinYScale
-                .MaximumScaleIsAuto = True
-                .MinorUnitIsAuto = True
-                .MajorUnitIsAuto = True
-                .Crosses = xlCustom
-                .CrossesAt = MinYScale
-                .ReversePlotOrder = False
-                .ScaleType = xlLinear
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            .ChartTitle.Top = 5
-            .ChartTitle.Left = 5
-            With .Legend
-                .Top = 5
-                .Fill.OneColorGradient _
-                    Style:=msoGradientHorizontal, _
-                    Variant:=3, _
-                    Degree:=0.303913939116503
-                .Fill.Visible = True
-                .Fill.ForeColor.SchemeColor = 71
-            End With
-            .PlotArea.Left = 10
-            .PlotArea.Top = .Legend.Top + .Legend.Height + 5
-            .PlotArea.Width = .ChartArea.Width - 20
-            .PlotArea.Height = .ChartArea.Height - .PlotArea.Top
-            
-' Tune OPEN line
-            With .SeriesCollection(1)
-                .Border.LineStyle = xlNone
-                .MarkerBackgroundColorIndex = xlNone
-                .MarkerForegroundColorIndex = 1
-                .MarkerStyle = xlPlus
-                .Smooth = False
-                .MarkerSize = 9
-                .Shadow = False
-            End With
-' Tune CLOSE line
-            With .SeriesCollection(2)
-                .Border.ColorIndex = 10
-                .Border.Weight = xlMedium
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune RESISTANCE line
-            With .SeriesCollection(3)
-                .Border.ColorIndex = 3
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune SUUPORT line
-            With .SeriesCollection(4)
-                .Border.ColorIndex = 25
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-            If SignalDefined Then
-                With .SeriesCollection(5)
-                    .Border.ColorIndex = 6
-                    .Border.Weight = xlThin
-                    .Border.LineStyle = xlDot
-                End With
-            End If
-        End With
-        .Application.Cursor = xlDefault
-        With .Worksheets(CHART_SHEET)
-            .Range("A1").Select
-            .Protect userInterfaceOnly:=True
-        End With
-    End With
-End Sub
-
-Function GetMinValue(DataRange As Range) As Double
-    Dim Cell As Range
-    Dim MinValue, MaxValue, RangeValue, CorrectValue, Mult As Double
-    MinValue = MAX_PRICE_VALUE
-    MaxValue = MIN_PRICE_VALUE
-    For Each Cell In DataRange
-        If Not IsEmpty(Cell) And IsNumeric(Cell) Then
-            If Cell > MIN_PRICE_VALUE Then
-                If Cell < MinValue Then
-                    MinValue = Cell
-                End If
-                If Cell > MaxValue Then
-                    MaxValue = Cell
-                End If
-            End If
-        End If
-    Next
-    RangeValue = MaxValue - MinValue
-    If RangeValue < 0 Then
-        MinValue = 0
-    Else
-        CorrectValue = RangeValue / 4
-        Mult = MIN_PRICE_VALUE
-        While MinValue - Int(MinValue * Mult) / Mult > CorrectValue
-            Mult = Mult * 10
-        Wend
-        MinValue = Int(MinValue * Mult) / Mult
-    End If
-    GetMinValue = MinValue
-End Function
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{35D51C1F-97FA-4A43-AFD8-907E207B8623}{337D4835-40CC-4F14-BAEB-0008DC0F4CDA}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mWebQeury
->>>>>>
-Attribute VB_Name = "mWebQeury"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.name = QryName Then
-            WebQuery.delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-Attribute CreateCommandBar.VB_ProcData.VB_Invoke_Func = "R\n14"
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Contents"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 49
-                        .OnAction = "cmHelpContents"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim curdate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    curdate = year * 10000
-    curdate = curdate + month * 100
-    curdate = curdate + day
-    If curdate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mTool
->>>>>>
-Attribute VB_Name = "mTool"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub tool_delete_all_tables()
-    QryDelete ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range("A1")
-End Sub
-
-Sub tool_delete_all_charts(theSheet As Worksheet)
-    Dim theChart As Chart
-    For Each theChart In theSheet
-        theChart.Unprotect
-        theChart.delete
-    Next
-End Sub
-
-Sub DateTimeTest()
-    Dim the_date
-    Dim the_time
-    the_date = DateValue(Now)
-    the_time = TimeValue(Now)
-End Sub
-
-
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{D9A1733C-82C5-4284-875F-95D7994101E1}{8ACF2A5D-5534-489E-8C57-88CB97F9CEEB}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-
-Private Sub App_WorkbookOpen(ByVal wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.count > 1 Then
-        wbname = wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-mDataCommands
->>>>>>
-Attribute VB_Name = "mDataCommands"
-Option Explicit
-
-Sub evFileOpen()
-    Dim fileToOpen As String
-    Dim wb As Workbook
-    Dim ticker As String
-    Dim Result As Integer
-
-    fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
-    Set wb = ThisWorkbook
-    With wb
-        If fileToOpen <> "False" Then
-            If .Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = True Then
-                .Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = False
-            End If
-            .Worksheets(FORM_SHEET).Range(FILE_NAME) = fileToOpen
-            Result = UpdateHistoryFromFile(wb, fileToOpen)
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            
-            ClearResultTables
-            
-            Select Case Result
-                Case FUNCRES_FILE_OK
-                    .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = True
-                    If TDenmark_Calc Then
-                        With .Worksheets(RAW_DATA_SHEET)
-                            ticker = .Range("B1")
-                        End With
-                        With .Worksheets(FORM_SHEET)
-                            .Range("CALC_TICKER_NAME") = ticker
-                        End With
-                    End If
-                Case FUNCRES_FILE_VERY_SMALL
-                    .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_VERY_SMALL
-                    MsgBox MSG_FILE_VERY_SMALL, vbOKOnly, PROGRAM_NAME
-                Case FUNCRES_FILE_INVALID_FORMAT
-                    .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_INVALID_FORMAT
-                    MsgBox MSG_FILE_INVALID_FORMAT, vbOKOnly, PROGRAM_NAME
-                End Select
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-    End With 'wb
-End Sub
-
-Sub evSubmit_Click()
-    Dim ticker As String
-
-    Application.Cursor = xlWait
-    Dim wb As Workbook
-    Set wb = ThisWorkbook
-    With wb
-        With .Worksheets(VAR_SHEET)
-            ticker = .Range("DEN_SYMBOL")
-            If .Range("BOOL_DATA_READY") = False Or .Range("BOOL_LOAD_DATA") = True Then
-                .Range("BOOL_DATA_READY") = UpdateHistoryFromWeb(wb)
-            End If
-            .Range("BOOL_DEMARK_READY") = False
-        End With
-        If TDenmark_Calc Then
-            With .Worksheets(FORM_SHEET)
-                .Range("CALC_TICKER_NAME") = ticker
-                .Range("FILE_NAME") = ""
-            End With
-        End If
-    End With
-    Application.Cursor = xlDefault
-End Sub
-
-Sub evTicker_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SECNAME") = .Range("IDX_DEN_SYMBOL")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evSecName_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SYMBOL") = .Range("IDX_DEN_SECNAME")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evHistory_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_DATA_READY") = False
-    End With
-End Sub
-
-Sub evGroupChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        GroupIdx = .Range("IDX_DEN_LIST")
-        .Range("IDX_DEN_SYMBOL") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat.ListFillRange = NewCbxRange
-        NewRangeOffsetCol = NewRangeOffsetCol + 1
-        NewCbxRange = .name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat.ListFillRange = NewCbxRange
-    End With
-    evTicker_Change
-End Sub
-
-Sub evUpdateTickerList()
-    UpdateTickerList ThisWorkbook
-    evHistory_Change
-End Sub
-<<<<<<
-======================
-mGetFileData
->>>>>>
-Attribute VB_Name = "mGetFileData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Public Const MAX_LOAD_DATA_LINES As Integer = 16000
-
-Public Const MSG_FILE_VERY_SMALL As String = "� ����� ������������ ������"
-Public Const MSG_FILE_INVALID_FORMAT As String = "�������� ������ �����"
-
-Public Const FUNCRES_FILE_OK As Integer = 0
-Public Const FUNCRES_FILE_VERY_SMALL As Integer = -1
-Public Const FUNCRES_FILE_INVALID_FORMAT As Integer = -2
-
-Function UpdateHistoryFromFile(wb As Workbook, fileToOpen As String) As Integer
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    Dim SingleFileLine As String
-    Dim FileHandler As Integer
-    Dim i, j, row_idx As Integer
-    
-    UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = True
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            'Clear table include temp area
-            .Parent.Application.DisplayAlerts = False
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            
-            ' Reading data from file
-            FileHandler = FreeFile
-            row_idx = 0
-            Open fileToOpen For Input As #FileHandler
-            Do While Not EOF(FileHandler) And row_idx < MAX_LOAD_DATA_LINES
-                Line Input #FileHandler, SingleFileLine
-                .Range(PRICE_TABLE).Offset(row_idx, 0) = SingleFileLine
-                row_idx = row_idx + 1
-            Loop
-            Close #FileHandler
-            
-            ' Parsing data
-            DestRangeName = "=" & RAW_DATA_SHEET & "!$B$1:$B" & row_idx
-            ResultLength = row_idx
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-            .Parent.Application.DisplayAlerts = True
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            
-            If Not CheckFileFormat(RawData.Offset(-1, 0)) Then
-                UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-                Exit Function
-            End If
-            
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).delete xlShiftUp
-            Else
-                UpdateHistoryFromFile = FUNCRES_FILE_VERY_SMALL
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromFile = FUNCRES_FILE_OK
-End Function
-
-Function CheckFileFormat(HeaderString As Range) As Boolean
-    With HeaderString
-        CheckFileFormat = _
-            .Offset(0, DATE_IDX) = "Date" And _
-            .Offset(0, TIME_IDX) = "Time" And _
-            .Offset(0, OPEN_IDX) = "Open" And _
-            .Offset(0, CLOSE_IDX) = "Close" And _
-            .Offset(0, LOW_IDX) = "Low" And _
-            .Offset(0, HIGH_IDX) = "High" And _
-            .Offset(0, VOLUME_IDX) = "Volume"
-    End With
-End Function
-<<<<<<
-Project Name : 'Denmark_method'
-Quirk - duff tag length======================
-MGetWebData
->>>>>>
-Attribute VB_Name = "MGetWebData"
-Option Explicit
-
-Const DATE_STAMP_OFFSET = PROJECT_IDX + 1
-Const TIME_STAMP_OFFSET = PROJECT_IDX + 4
-Const DATE_TIME_STAMP_SIZE = 5
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Const QueryDataName As String = "ExternalDenmarkData"
-
-Function UpdateHistory(wb As Workbook) As Boolean
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    UpdateHistory = False
-    QryPathStr = GetQryPath(wb)
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = IsNumeric(.Range("DEN_TIME"))
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table include temp area
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-    
-    '        .Parent.Application.DisplayAlerts = False
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-    '        .Parent.Application.DisplayAlerts = True
-            Dim i, j, row_idx As Integer
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).delete xlShiftUp
-            Else
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).delete xlShiftUp
-                End If
-            Else
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = "'" & Location.Cells(1 + row_idx, 1)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And TimeValue(Now) < TimeSerial(18, 0, 0)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistory = True
-End Function
-
-Private Function GetQryPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    Dim IsIntradai As Boolean
-    Dim DayCount As Integer
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/online/nph-single-old.cgi?"
-        QryPathStr = QryPathStr & "ticker=" & .Range("DEN_SYMBOL")
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        IsIntradai = IsNumeric(.Range("DEN_TIME"))
-        If IsIntradai Then
-            QryPathStr = QryPathStr & "&period=" & .Range("DEN_TIME")
-        Else
-            QryPathStr = QryPathStr & "&period=60"
-        End If
-        QryPathStr = QryPathStr & "&oh=11&ch=18"
-        QryPathStr = QryPathStr & "&separator=%2C"
-        QryPathStr = QryPathStr & "&vmode=Ignore&vtype=BA2"
-        QryPathStr = QryPathStr & "&format=Excel"
-        
-        If IsIntradai Then
-            DayCount = .Range("DEN_HISTORY") * .Range("DEN_TIME") \ 420 + 1 + .Range("DEN_HISTORY")
-        Else
-            DayCount = .Range("DEN_HISTORY")
-        End If
-        QryPathStr = QryPathStr & "&daysback=" & DayCount
-'        .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-    
-End Function
-
-Sub UpdateTickerList(wb As Workbook)
-    Dim Idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    QryPathStr = GetListPath(wb)
-    With wb
-        With .Worksheets(VAR_SHEET)
-            Idx = .Range("IDX_DEN_LIST")
-            Set Location = .Range("TICKER_TABLES").Offset(0, (Idx - 1) * 2)
-             .Range("IDX_DEN_SYMBOL") = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            ' Remove header
-            ' Find [DATA]
-            n = 0
-            Do While Location.Offset(n, 0) <> "[DATA]"
-                n = n + 1
-            Loop
-            .Range(Location.Offset(1, 0), Location.Offset(n, 1)).delete Shift:=xlUp
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-        
-        '        .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 0), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-        ' Setup Ticker List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-    End With
-End Sub
-
-Private Function GetListPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://online.rbc.ru/cgi-bin/names.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "&board=" & .Range("DEN_BOARD")
-        QryPathStr = QryPathStr & "&category=STOCKS"
-        '.Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Application.ScreenUpdating = False
-    If Application.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        Shell "EXCEL " & wbname
-        ThisWorkbook.Close Savechanges:=False
-        Exit Sub
-    End If
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            ThisWorkbook.Save
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(FORM_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mReadWrite
->>>>>>
-Attribute VB_Name = "mReadWrite"
-Option Explicit
-
-Public Const GOOD_LINE_STATUS As String = "Ok"
-Public Const BAD_LINE_STATUS As String = "N/A"
-
-Function ReadWebData(Location As Range, Hist As Integer, dt As Integer, _
-              pPriceData As TPriceData) As Integer
-    '������������� ���� TPriceData �� ������� ���� - 1
-    'k��������� �� ����� ��� hist ��������� �����
-    'aPoint - ������ �������
-    '������ ��� ������ ������� �������������� ������ (������)
-    Dim n, i As Integer
-    
-    '����������� ����� ����� ������� - n
-    n = GetLinesCount(Location)
-    ReadWebData = n
-    If n < 9 Then             '���������� ������ !!!
-        GoTo done
-    End If
-    ' ����� ����� ���������� ()
-    If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-        Hist = (n - 3) \ dt + 1 '
-    End If
-    Dim t, s As Integer
-    For t = 0 To Hist - 1
-        s = n - t * dt - 1
-        pPriceData.D(Hist - t) = Location.Offset(s, DATE_IDX).Value
-        pPriceData.Tm(Hist - t) = Location.Offset(s, TIME_IDX).Value
-        pPriceData.Opn(Hist - t) = Location.Offset(s, OPEN_IDX).Value
-        pPriceData.Hgh(Hist - t) = Location.Offset(s, HIGH_IDX).Value
-        pPriceData.Lw(Hist - t) = Location.Offset(s, LOW_IDX).Value
-        pPriceData.Cls(Hist - t) = Location.Offset(s, CLOSE_IDX).Value
-        pPriceData.Vl(Hist - t) = Location.Offset(s, VOLUME_IDX).Value
-    Next t
-    ReadWebData = t + 1
-done:
-End Function
-
-Sub ResultLinesOut(Location As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim n As Integer
-    
-    n = GetLinesCount(Location)
-    With Location
-        .Offset(-1, RESIST_IDX) = "Resistance"
-        .Offset(-1, SUPPORT_IDX) = "Support"
-        .Offset(-1, PROJECT_IDX) = "Project"
-    End With
-    Dim t, count, Idx, loc_idx As Integer
-    count = pPD.tC
-    For t = 0 To count - 1
-        Idx = count - t
-        loc_idx = n - t - 1
-        If pDen.ResistanceLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, RESIST_IDX).Value = pDen.ResistanceLine(Idx)
-        End If
-        If pDen.SupportLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, SUPPORT_IDX).Value = pDen.SupportLine(Idx)
-        End If
-        If Abs(pDen.SignalValue) > 1 Then
-            Location.Offset(loc_idx, PROJECT_IDX).Value = pDen.ProjectPrice
-        End If
-    Next t
-End Sub
-
-Sub Out_Table_1(TheRange As Range, pDen As TDenmark, LastIdx As Integer)
-    
-    
-    ' Col = 2 - �� ��������� !!!
-    ' Status - Col = 0
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(0, 0).Value = BAD_LINE_STATUS
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(1, 0).Value = BAD_LINE_STATUS
-    End If
-    ' -----------------------------------------
-    ' ���� �������� ����� ������������� � ��������� - Col = 1
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 1).Value = pDen.ResistanceAngle
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 1).Value = pDen.SupportAngle
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 1).Value = (pDen.ResistanceAngle + pDen.SupportAngle) / 2
-    End If
-    ' -----------------------------------------
-    ' ������� ���� ����� �������� �� ������� ������
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 2).Value = pDen.ResistanceLine(LastIdx)
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 2).Value = pDen.SupportLine(LastIdx)
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 2).Value = _
-            (pDen.ResistanceLine(LastIdx) + pDen.SupportLine(LastIdx)) / 2
-    End If
-    
-End Sub
-
-Sub Out_Table_2(TheRange As Range, TheComment As Range, pPD As TPriceData, pDen As TDenmark)
-    Const ColorIndexBUY = 5
-    Const ColorIndexSELL = 3
-    Const ColorIndexNOTHINK = 14
-    
-    Dim SignalValue_defined, allert_enable  As Boolean
-    Dim Message As String
-    SignalValue_defined = False
-    allert_enable = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_ALLERT_DLG")
-    Message = "������ �� ��������� ������ �� ���������������."
-    If pDen.SignalValue >= 2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "BUY"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexBUY
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue - 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "BUY Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & pDen.SignalValue - 1 & " ! "
-    End If
-    If pDen.SignalValue <= -2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "SELL"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexSELL
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue + 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "SELL Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(pDen.SignalValue + 1) & "!"
-    End If
-    With TheComment
-        .Value = Message
-        .Font.Bold = True
-        Dim color_idx As Integer
-        If SignalValue_defined Then
-            If pDen.SignalValue > 0 Then
-                .Font.ColorIndex = ColorIndexBUY
-            Else
-                .Font.ColorIndex = ColorIndexSELL
-            End If
-        Else
-            .Font.ColorIndex = ColorIndexNOTHINK
-        End If
-    End With
-    If allert_enable And SignalValue_defined Then
-        MsgBox _
-            Prompt:=Message, _
-            Title:=PROGRAM_NAME, _
-            Buttons:=vbOKOnly + vbInformation
-    End If
-End Sub
-
-Sub Out_Table_3(TheRange As Range, pDen As TDenmark)
-    Dim i As Integer
-    For i = 1 To 3
-        TheRange.Offset(i - 1, 0).Value = pDen.Qualificator(i)
-    Next i
-End Sub
-
-Sub Out_Table_4(TheRange As Range, pPD As TPriceData)
-    Dim LastIdx As Integer
-    LastIdx = pPD.tC
-    With TheRange
-        .Offset(0, 0).Value2 = "'" & pPD.D(LastIdx)
-        .Offset(0, 1).Value2 = "'" & pPD.Tm(LastIdx)
-        .Offset(0, 2) = pPD.Opn(LastIdx)
-        .Offset(0, 3) = pPD.Hgh(LastIdx)
-        .Offset(0, 4) = pPD.Lw(LastIdx)
-        .Offset(0, 5) = pPD.Cls(LastIdx)
-        .Offset(0, 6) = pPD.Cls(LastIdx) - pPD.Cls(LastIdx - 1)
-    End With
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Denmark method bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-    End With
-    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(wb As Workbook)
-    With wb
-        .Application.ScreenUpdating = False
-        
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(FORM_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-            .Select
-        End With
-        With .Worksheets(CHART_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-        End With
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(wb As Workbook)
-    With wb
-        .Unprotect
-        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Unprotect
-        End With
-        With .Worksheets(FORM_SHEET)
-            .Select
-            .Unprotect
-        End With
-        .Application.ScreenUpdating = True
-        
-    End With
-End Sub
-
-<<<<<<
-======================
-mTypes
->>>>>>
-Attribute VB_Name = "mTypes"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "����� �-�� �������"
-Public Const PROGRAM_VERSION As String = "version 1.0 Professional"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-Public Const ESTIMATION_DATE As Long = 19990413
-'Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "J27"
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const PRICE_TABLE As String = "B1"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-Public Const VAR_SHEET As String = "Var_s"
-
-Public Const CHART_SHEET As String = "Chart"
-
-Public Const MIN_PRICE_VALUE As Double = 0.000001
-Public Const MAX_PRICE_VALUE As Double = 1000000000
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const CLOSE_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const HIGH_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const RESIST_IDX As Integer = 7
-Public Const SUPPORT_IDX As Integer = 8
-Public Const PROJECT_IDX As Integer = 9
-
-Type TPriceData
-    D() As String      ' ����������� ����
-    Tm() As String     ' �����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Double     ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type TDenmark
-   ResistanceLine() As Double           'Resistance line
-   ResistancePoints() As Integer        'Resistance pivot points
-   ResistancePointCount As Integer      'The number of resistance pivot points
-   ResistanceAngle As Double            'Angle of Declination of ResistanceLine
-   
-   SupportLine() As Double              'Support line
-   SupportPoints() As Integer           'Support pivot points
-   SupportPointsCount As Integer        'The number of support pivot points
-   SupportAngle As Double               ' Angle of Declination of SupportLine
-   
-   SignalParameter     As Integer       ' parameter for SignalValue
-   SignalValue      As Integer          'SignalValue
-   
-   
-   Qualificator(1 To 3) As String       ' qualificators
- 
-   ProjectNumber As Integer             ' ����� ��������
-   ProjectPrice  As Double              ' �������� ����
-   
-End Type
-
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-Dim AppRunEnable As New cEnableRun
-
-Sub evHistory_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_DATA_READY") = False
-    End With
-End Sub
-
-Sub evSubmit_Click()
-    Dim ticker As String
-
-    Application.Cursor = xlWait
-    Dim wb As Workbook
-    Set wb = ThisWorkbook
-    With wb
-        With .Worksheets(VAR_SHEET)
-            ticker = .Range("DEN_SYMBOL")
-            If .Range("BOOL_DATA_DOWNLOAD") = True Or .Range("BOOL_DATA_READY") = False Then
-                .Range("BOOL_DATA_READY") = UpdateHistory(wb)
-                .Range("BOOL_DENMARK_READY") = False
-            End If
-        End With
-        If TDenmark_Calc Then
-            With .Worksheets(FORM_SHEET)
-                .Range("CALC_TICKER_NAME") = ticker
-            End With
-        End If
-    End With
-    Application.Cursor = xlDefault
-    
-End Sub
-
-
-Sub evParamChange()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DENMARK_READY") = False
-End Sub
-
-Sub evGroupChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        GroupIdx = .Range("IDX_DEN_LIST")
-        .Range("IDX_DEN_SYMBOL") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat.ListFillRange = NewCbxRange
-    End With
-    evHistory_Change
-End Sub
-
-Sub evUpdateTickerList()
-    UpdateTickerList ThisWorkbook
-    evHistory_Change
-End Sub
-
-Sub cmViewChart(Optional SwapPage As Boolean = True)
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_CHART_READY") = False
-        If .Range("BOOL_DENMARK_READY") <> True Then
-            If .Range("BOOL_AUTORECALC") = True Then
-                evSubmit_Click
-                If .Range("BOOL_DENMARK_READY") <> True Then
-                    Exit Sub
-                End If
-            Else
-                MsgBox _
-                    "������ �� ����� ���� ��������." & vbCrLf & "�������� ������ �� ����������.", _
-                    vbOKOnly + vbExclamation, _
-                    PROGRAM_NAME
-                Exit Sub
-            End If
-        End If
-    End With
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        With .Range("TABLE_1")
-            Dim test_lines As Boolean
-            test_lines = StrComp(.Cells(1, 1).Value, GOOD_LINE_STATUS)
-            test_lines = test_lines + StrComp(.Cells(2, 1).Value, GOOD_LINE_STATUS)
-            If test_lines <> 0 Then
-                MsgBox _
-                    Prompt:="������ �� ����� ���� ��������." & vbCrLf & "������� ����� �� ���������� .", _
-                    Title:=PROGRAM_NAME, _
-                    Buttons:=vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End With
-        Draw_Chart Not IsEmpty(.Range("TABLE_2").Cells(1, 1))
-    End With
-    With ThisWorkbook
-        .Worksheets(VAR_SHEET).Range("BOOL_CHART_READY") = True
-        If SwapPage Then
-            .Worksheets(CHART_SHEET).Select
-        End If
-    End With
-End Sub
-
-Sub cmViewForm()
-    With ThisWorkbook
-        .Worksheets(FORM_SHEET).Select
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Dim ResistanceLine
-    ResistanceLine = MsgBox( _
-        Prompt:="�� ������� ��������� ���������?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If ResistanceLine = vbYes Then
-       Application.Quit
-    End If
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Demark.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable wb:=ThisWorkbook
-    SetEnvironment wb:=ThisWorkbook
-    ProtectionEnable wb:=ThisWorkbook
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable wb:=ThisWorkbook
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=True
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmPrint()
-    If MsgBox( _
-            Prompt:="�� ������� ����������� ���������?", _
-            Buttons:=vbYesNo + vbQuestion, _
-            Title:=PROGRAM_NAME) = vbNo _
-    Then
-        Exit Sub
-    End If
-    Dim s_ticker, s_name, s_time As String
-    s_ticker = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME")
-    s_name = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_NAME")
-    s_time = Now
-    Application.ScreenUpdating = False
-    cmViewChart SwapPage:=False
-    Application.ScreenUpdating = False
-    With ThisWorkbook.Worksheets(FORM_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    With ThisWorkbook.Worksheets(CHART_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    Application.ScreenUpdating = False
-    ThisWorkbook.Worksheets(Array("MainForm", "Chart")).PrintOut Copies:=1, Collate:=True
-    cmViewForm
-End Sub
-<<<<<<
-======================
-mDemark
->>>>>>
-Attribute VB_Name = "mDemark"
-Option Explicit
-
-Public Const FORM_SHEET As String = "MainForm"
-
-'Form Ranges
-Public Const TABLE_1 As String = "TABLE_1"
-Public Const TABLE_2 As String = "TABLE_2"
-Public Const TABLE_3 As String = "TABLE_3"
-Public Const TABLE_4 As String = "TABLE_4"
-Public Const TABLE_COMMENT As String = "TABLE_COMMENT"
-
-'�������� ��� ������ - �������� 1
-
-'*********************
-Dim PriceDataArray As TPriceData
-Dim DenmarkDataArray As TDenmark
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Function TDenmark_Calc() As Boolean
-    
-    Dim nWindow As Integer
-    Dim bPrevCloseFilter, bSuccCloseFilter As Boolean
-    
-    TDenmark_Calc = False
-    
-    mobjAppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-'1)    Read User data
-        With .Worksheets(VAR_SHEET)
-            DenmarkDataArray.ProjectNumber = .Range("DEN_PROECT").Value
-            DenmarkDataArray.SignalParameter = .Range("DEN_PARAM").Value
-            nWindow = .Range("DEN_WINDOW").Value
-            bPrevCloseFilter = .Range("BOOL_PREV_CLOSE").Value
-            bSuccCloseFilter = .Range("BOOL_SUCC_CLOSE").Value
-        End With
-
-'2)   Memory allocation
-        allocate_memory PriceDataArray, DenmarkDataArray, nWindow
-
-'3)   Read data
-        Dim TheRange As Range
-        Set TheRange = .Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE)
-        Dim LinesCount As Integer
-        LinesCount = ReadWebData(Location:=TheRange, Hist:=PriceDataArray.tC, dt:=1, pPriceData:=PriceDataArray)
-        
-        'Init function result
-        TDenmark_Calc = LinesCount >= nWindow
-        
-        If LinesCount >= nWindow Then
-        
-'4)   Calculate metod TDenmarkDataArray
-            DetDenmark PriceDataArray, DenmarkDataArray, bPrevCloseFilter, bSuccCloseFilter
-            If Abs(DenmarkDataArray.SignalValue) > 1 Then  '������� ���������, ���� ���� ������
-                DetProj PriceDataArray, DenmarkDataArray
-            End If
-'5)   Write result
-            Application.ScreenUpdating = False
-    
-'6)    Clear interface tables
-            With .Worksheets(FORM_SHEET)
-                .Range(TABLE_1).ClearContents ' �������-1
-                .Range(TABLE_2).ClearContents ' �������-2
-                .Range(TABLE_3).ClearContents ' �������-3
-                .Range(TABLE_COMMENT).Value = "" ' ����������-3
-                .Range(TABLE_4).ClearContents ' �������-4
-            End With
-    
-            ResultLinesOut Location:=TheRange.Offset(2, 0), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-            
-            With .Worksheets(FORM_SHEET)
-                Out_Table_1 TheRange:=.Range(TABLE_1).Cells(1, 1), pDen:=DenmarkDataArray, LastIdx:=PriceDataArray.tC
-                Out_Table_2 _
-                        TheRange:=.Range(TABLE_2).Cells(1, 1), _
-                        TheComment:=.Range("TABLE_COMMENT"), _
-                        pPD:=PriceDataArray, _
-                        pDen:=DenmarkDataArray
-                Out_Table_3 TheRange:=.Range(TABLE_3).Cells(1, 1), pDen:=DenmarkDataArray
-                Out_Table_4 TheRange:=.Range(TABLE_4).Cells(1, 1), pPD:=PriceDataArray
-                With .Range(TABLE_1)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_2)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_3)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_4)
-                    .Font.name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-            End With
-            .Worksheets(VAR_SHEET).Range("BOOL_DENMARK_READY") = True
-        Else
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            .Worksheets(VAR_SHEET).Range("BOOL_DENMARK_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-'7)   Free unused memory
-        free_unused_memory PriceDataArray, DenmarkDataArray
-    End With
-End Function
-
-Sub allocate_memory(pPriceData As TPriceData, pDenmarkData As TDenmark, memsize As Integer)
-'  ������ ��� TDenmark
-    ReDim pDenmarkData.ResistanceLine(1 To memsize)
-    ReDim pDenmarkData.ResistancePoints(1 To memsize)
-    ReDim pDenmarkData.SupportLine(1 To memsize)
-    ReDim pDenmarkData.SupportPoints(1 To memsize)
-   
-' ������������� ������ �� �����
-    pPriceData.tC = memsize
-    ReDim pPriceData.D(1 To memsize)
-    ReDim pPriceData.Tm(1 To memsize)
-    ReDim pPriceData.Opn(1 To memsize)
-    ReDim pPriceData.Hgh(1 To memsize)
-    ReDim pPriceData.Lw(1 To memsize)
-    ReDim pPriceData.Cls(1 To memsize)
-    ReDim pPriceData.Vl(1 To memsize)
-
-End Sub
-
-Sub free_unused_memory(pP As TPriceData, pD As TDenmark)
-'   Free Prices
-    pP.tC = 0
-    Erase pP.D
-    Erase pP.Tm
-    Erase pP.Opn
-    Erase pP.Hgh
-    Erase pP.Lw
-    Erase pP.Cls
-    Erase pP.Vl
-    
-'Free TDenmark
-    Erase pD.ResistanceLine
-    Erase pD.ResistancePoints
-    Erase pD.SupportLine
-    Erase pD.SupportPoints
-End Sub
-
-
-'*****************************************
-Sub DetDenmark(pPriceData As TPriceData, pDenmarkData As TDenmark, ByVal ClosePrev2 As Boolean, ByVal CloseSucc1 As Boolean)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPriceData  - ����, ����������� ����� ������ �� ����� (����������)
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' pDenmarkData - �������� ������ �������� (������ ��������, SignalParameter - ���������):
-' ����� ResistanceLine,SupportLine �� �������, ������� �����, ������� � ������� ��� �������
-' SignalValue = 0 ������ �����������
-' SignalValue < 0 ������ ����������� ������ (������ �������)
-' SignalValue > 0 ������ ����������� ������ (������ �������)
-' ���� pDenmarkData.ResistancePointCount < 2, �� �������� ResistanceLine �� ������������
-' ���� pDenmarkData.SupportPointsCount < 2, �� �������� SupportLine �� ������������
-
-' ��������� ���������
-    Const QUALIFICATOR_DISABLE As String = "-"
-    Const QUALIFICATOR_ENABLE As String = "Signal"
-    
-    Dim UpQual(1 To 3) As String
-    Dim DownQual(1 To 3) As String
-    Dim UpSignal, DownSignal As Integer
-    Dim i As Integer
-    
-    pDenmarkData.SignalValue = 0
-    UpSignal = 0
-    DownSignal = 0
-    
-    For i = 1 To 3
-        pDenmarkData.Qualificator(i) = QUALIFICATOR_DISABLE
-        UpQual(i) = QUALIFICATOR_DISABLE
-        DownQual(i) = QUALIFICATOR_DISABLE
-    Next i
-    
-' ����������� ����� ��������� � �������������
-    ResLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.ResistancePointCount, _
-        pDenmarkData.ResistanceLine, _
-        pDenmarkData.ResistancePoints, _
-        ClosePrev2, _
-        CloseSucc1
-        
-    SuppLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.SupportPointsCount, _
-        pDenmarkData.SupportLine, _
-        pDenmarkData.SupportPoints, _
-        ClosePrev2, _
-        CloseSucc1
-
-        
-        
-    If pDenmarkData.ResistancePointCount >= 2 Then
-        pDenmarkData.ResistanceAngle = 57.29578 * _
-            Atn(pDenmarkData.ResistanceLine(pPriceData.tC) - _
-                pDenmarkData.ResistanceLine(pPriceData.tC - 1))
-    End If
-    If pDenmarkData.SupportPointsCount >= 2 Then
-        pDenmarkData.SupportAngle = 57.29578 * _
-            Atn(pDenmarkData.SupportLine(pPriceData.tC) - _
-                pDenmarkData.SupportLine(pPriceData.tC - 1))
-    End If
-
-' ������������ ������� ----------------------------------
-    Dim t As Integer
-' 1. ������ ����������� ������: ResistanceLine ��������� � ResistanceLine ������ *************
-    If pDenmarkData.ResistancePointCount >= 2 And pDenmarkData.ResistanceAngle < 0 Then
-'    ����������� ������� ������� �����
-        If pDenmarkData.ResistanceLine(pPriceData.tC) < pPriceData.Cls(pPriceData.tC) Then
-            UpSignal = 1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) > pDenmarkData.ResistanceLine(t) Then
-                    UpSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If UpSignal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) > pPriceData.Cls(pPriceData.tC - 1) Then
-                UpSignal = UpSignal + 1
-                UpQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: open > ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) > pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - demand value < ResistanceLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Lw(pPriceData.tC - 1) < pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-    End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: SupportLine ��������� � SupportLine ������
-    If pDenmarkData.SupportPointsCount >= 2 And pDenmarkData.SupportAngle > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-        If pPriceData.Cls(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-            DownSignal = -1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) < pDenmarkData.SupportLine(t) Then
-                    DownSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If DownSignal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) < pPriceData.Cls(pPriceData.tC - 1) Then
-                DownSignal = DownSignal - 1
-                DownQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: Open ���� ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - supply value(t-1) > SupportLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Hgh(pPriceData.tC - 1) > pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-'    ---------------------------------------------
-    End If
-'      ���������� ������������ ���������
-    If Abs(DownSignal) <> UpSignal Then
-        If Abs(DownSignal) > UpSignal Then
-            pDenmarkData.SignalValue = DownSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = DownQual(i)
-            Next i
-        Else
-            pDenmarkData.SignalValue = UpSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = UpQual(i)
-            Next i
-        End If
-    End If
-End Sub
-
-Sub DetProj(pPriceData As TPriceData, pDenmarkData As TDenmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-    Dim pM As Double, t As Integer, Tm As Integer, tL As Integer
-
-    If pDenmarkData.SignalValue >= 2 Then  ' ������ �������
-
-        tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount)     ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2 Then
-'           t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < ResistanceLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Lw(Tm) ' L(t-1) < ResistanceLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Lw(t) < pM And pPriceData.Lw(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Lw(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
-'               P1( tb) = ResistanceLine(tb) + ResistanceLine(t*) - L(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Lw(Tm)
-            Else
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If ' pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < ResistanceLine(t)}
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Cls(t) < pM And pPriceData.Cls(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue >= 2
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-    If pDenmarkData.SignalValue <= -2 Then
-        tL = pDenmarkData.SupportPoints(pDenmarkData.SupportPointsCount)  ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.SupportPointsCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber = 1 Or pDenmarkData.ProjectNumber = 2 Then
-'           t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > SupportLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Hgh(Tm) ' H(t-1) > SupportLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Hgh(t) > pM And pPriceData.Hgh(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Hgh(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
- '              P1( tb) = SupportLine(tb) + SupportLine(t*) - H(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Hgh(Tm)
-            Else
-'               P2( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  SupportLine(t)}
-'           P3( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pM < pPriceData.Cls(t) And pPriceData.Cls(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue <= -2
-End Sub
-
-Sub ResLine(pP As TPriceData, tE As Integer, ResistancePointCount As Integer, _
-            ResistanceLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� ResistanceLine, dom(ResistanceLine)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(ResistancePointCount)}, s(1) < s(2) < ...< s(ResistancePointCount)
-'   ( s(ResistancePointCount)<= tE )- ������� �����
-' 3) ����� ������� ����� ResistancePointCount.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� SupportLine
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-  
-'1 ����������� ������� �������� �������
-    ResistancePointCount = 0
-    For t = 3 To tE - 1
- '      v = max{high(t-1), high(t+1)} < high(t)}
-        v = pP.Hgh(t - 1)
-        If v < pP.Hgh(t + 1) Then
-            v = pP.Hgh(t + 1)
-        End If
-        IsGoodPoint = pP.Hgh(t) > v
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) < pP.Hgh(t))
-        End If
-        
-        If IsGoodPoint Then       'alt.: v >= High(t + 1)
-            s(ResistancePointCount + 1) = t: ResistancePointCount = ResistancePointCount + 1
-        End If
-    Next t
-    
-loop_:
-    
-    If ResistancePointCount < 2 Then
-        GoTo done
-    End If
-
-' 2 ����������� ����� �������������
-    ResistanceLine(s(1)) = pP.Hgh(s(1))
-    For i = 2 To ResistancePointCount
-        ResistanceLine(s(i)) = pP.Hgh(s(i))
-        v = (pP.Hgh(s(i)) - pP.Hgh(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            ResistanceLine(t) = pP.Hgh(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(ResistancePointCount) < tE Then
-        v = (pP.Hgh(s(ResistancePointCount)) - pP.Hgh(s(ResistancePointCount - 1))) / (s(ResistancePointCount) - s(ResistancePointCount - 1))
-        For t = s(ResistancePointCount) + 1 To tE
-            ResistanceLine(t) = pP.Hgh(s(ResistancePointCount - 1)) + v * (t - s(ResistancePointCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To ResistancePointCount
-            If ResistanceLine(s(t) + 1) < pP.Cls(s(t) + 1) Then
-                ResistancePointCount = ResistancePointCount - 1
-                ' ������� �����
-                For i = t To ResistancePointCount
-                    s(i) = s(i + 1)
-                Next i
-                s(ResistancePointCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(ResistanceLine)
-                Rb = UBound(ResistanceLine)
-                Erase ResistanceLine
-                ReDim ResistanceLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-    
-done:
-End Sub
-
-Sub SuppLine(pP As TPriceData, tE As Integer, SupportPointsCount As Integer, _
-               SupportLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� SupportLine, dom(SupportLine)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(SupportPointsCount)}, s(1) < s(2) < ...< s(SupportPointsCount) -
-'    ������� �����
-' 3) ����� ������� ����� SupportPointsCount.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-    
-'1 ����������� ������� �������� �������
-     SupportPointsCount = 0
-    For t = 3 To tE - 1
-'       v = min{Low(t-1), Low(t+1)} > Low(t)
-        v = pP.Lw(t - 1)
-        If v > pP.Lw(t + 1) Then
-            v = pP.Lw(t + 1)
-        End If
-        
-        IsGoodPoint = pP.Lw(t) < v
-        
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) > pP.Lw(t))
-        End If
-        
-        If IsGoodPoint Then     'alt.: v >= High(t + 1)
-            s(SupportPointsCount + 1) = t: SupportPointsCount = SupportPointsCount + 1
-        End If
-    Next t
-
-loop_:
-    If SupportPointsCount < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� ���������
-    
-    SupportLine(s(1)) = pP.Lw(s(1))
-    For i = 2 To SupportPointsCount
-        SupportLine(s(i)) = pP.Lw(s(i))
-        v = (pP.Lw(s(i)) - pP.Lw(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            SupportLine(t) = pP.Lw(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(1) < tE Then
-        v = (pP.Lw(s(SupportPointsCount)) - pP.Lw(s(SupportPointsCount - 1))) / (s(SupportPointsCount) - s(SupportPointsCount - 1))
-        For t = s(SupportPointsCount) + 1 To tE
-            SupportLine(t) = pP.Lw(s(SupportPointsCount - 1)) + v * (t - s(SupportPointsCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To SupportPointsCount
-            If SupportLine(s(t) + 1) > pP.Cls(s(t) + 1) Then
-                SupportPointsCount = SupportPointsCount - 1
-                ' ������� �����
-                For i = t To SupportPointsCount
-                    s(i) = s(i + 1)
-                Next i
-                s(SupportPointsCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(SupportLine)
-                Rb = UBound(SupportLine)
-                Erase SupportLine
-                ReDim SupportLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-done:
-End Sub
-
-<<<<<<
-======================
-mChart
->>>>>>
-Attribute VB_Name = "mChart"
-Option Explicit
-
-Const CHART_NAME As String = "PriceChart"
-
-Sub Draw_Chart(SignalDefined As Boolean)
-
-    Dim n As Integer
-    Dim theChart As Chart
-    Dim ChartDataAria, szLastNumber As String
-    Dim MinYScale As Double
-    
-    
-    With ThisWorkbook
-' Checking data
-' Disable screen out
-        .Application.Cursor = xlWait
-        .Application.ScreenUpdating = False
-' Create series range
-        n = GetLinesCount(Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE))
-        szLastNumber = n + 1
-        If SignalDefined Then
-            ChartDataAria = "A2:A" + szLastNumber + ",D2:E" + szLastNumber + ",I2:K" + szLastNumber
-        Else
-            ChartDataAria = "A2:A" + szLastNumber + ",D2:E" + szLastNumber + ",I2:J" + szLastNumber
-        End If
-        MinYScale = GetMinValue(.Worksheets(RAW_DATA_SHEET).Range(ChartDataAria))
-' Find and delete old chart
-        .Worksheets(CHART_SHEET).Unprotect
-        Dim WindowWidth, WindowHeight As Integer
-        With .Worksheets(CHART_SHEET)
-            WindowWidth = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            WindowHeight = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-        
-        
-        With .Worksheets(CHART_SHEET).ChartObjects
-            .delete
-            With .Add(5, 5, WindowWidth - 10, WindowHeight - 10)
-                .SendToBack
-                Set theChart = .Chart
-            End With
-' Create a chart
-        End With
-        With theChart
-            .ChartType = xlLine
-            .SetSourceData Source:=Sheets(RAW_DATA_SHEET).Range( _
-                    ChartDataAria), PlotBy:=xlColumns
-            .Location Where:=xlLocationAsObject, name:=CHART_SHEET
-            .HasTitle = True
-            With .ChartTitle
-                .Text = ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE).Value
-                With .Font
-                    .Size = 8
-                    .Bold = True
-                End With
-            End With
-            .HasLegend = True
-            With .Legend
-                .Position = xlTop
-                With .Font
-                    .name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            .HasDataTable = False
-            With .Axes(xlCategory)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                .TickLabels.Orientation = xlUpward
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .CrossesAt = 1
-                .TickLabelSpacing = 1
-                .TickMarkSpacing = 1
-                .AxisBetweenCategories = False
-                .ReversePlotOrder = False
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            With .Axes(xlValue)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .MinimumScale = MinYScale
-                .MaximumScaleIsAuto = True
-                .MinorUnitIsAuto = True
-                .MajorUnitIsAuto = True
-                .Crosses = xlCustom
-                .CrossesAt = MinYScale
-                .ReversePlotOrder = False
-                .ScaleType = xlLinear
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            .ChartTitle.Top = 5
-            .ChartTitle.Left = 5
-            With .Legend
-                .Top = 5
-                .Fill.OneColorGradient _
-                    Style:=msoGradientHorizontal, _
-                    Variant:=3, _
-                    Degree:=0.303913939116503
-                .Fill.Visible = True
-                .Fill.ForeColor.SchemeColor = 71
-            End With
-            .PlotArea.Left = 10
-            .PlotArea.Top = .Legend.Top + .Legend.Height + 5
-            .PlotArea.Width = .ChartArea.Width - 20
-            .PlotArea.Height = .ChartArea.Height - .PlotArea.Top
-            
-' Tune OPEN line
-            With .SeriesCollection(1)
-                .Border.LineStyle = xlNone
-                .MarkerBackgroundColorIndex = xlNone
-                .MarkerForegroundColorIndex = 1
-                .MarkerStyle = xlPlus
-                .Smooth = False
-                .MarkerSize = 9
-                .Shadow = False
-            End With
-' Tune CLOSE line
-            With .SeriesCollection(2)
-                .Border.ColorIndex = 10
-                .Border.Weight = xlMedium
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune RESISTANCE line
-            With .SeriesCollection(3)
-                .Border.ColorIndex = 3
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune SUUPORT line
-            With .SeriesCollection(4)
-                .Border.ColorIndex = 25
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-            If SignalDefined Then
-                With .SeriesCollection(5)
-                    .Border.ColorIndex = 6
-                    .Border.Weight = xlThin
-                    .Border.LineStyle = xlDot
-                End With
-            End If
-        End With
-        .Application.Cursor = xlDefault
-        With .Worksheets(CHART_SHEET)
-            .Range("A1").Select
-            .Protect userInterfaceOnly:=True
-        End With
-    End With
-End Sub
-
-Function GetMinValue(DataRange As Range) As Double
-    Dim Cell As Range
-    Dim MinValue, MaxValue, RangeValue, CorrectValue, Mult As Double
-    MinValue = MAX_PRICE_VALUE
-    MaxValue = MIN_PRICE_VALUE
-    For Each Cell In DataRange
-        If Not IsEmpty(Cell) And IsNumeric(Cell) Then
-            If Cell > MIN_PRICE_VALUE Then
-                If Cell < MinValue Then
-                    MinValue = Cell
-                End If
-                If Cell > MaxValue Then
-                    MaxValue = Cell
-                End If
-            End If
-        End If
-    Next
-    RangeValue = MaxValue - MinValue
-    If RangeValue < 0 Then
-        MinValue = 0
-    Else
-        CorrectValue = RangeValue / 4
-        Mult = MIN_PRICE_VALUE
-        While MinValue - Int(MinValue * Mult) / Mult > CorrectValue
-            Mult = Mult * 10
-        Wend
-        MinValue = Int(MinValue * Mult) / Mult
-    End If
-    GetMinValue = MinValue
-End Function
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{760A52A5-8475-11D2-B33C-525400DB02FE}{760A5296-8475-11D2-B33C-525400DB02FE}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mWebQeury
->>>>>>
-Attribute VB_Name = "mWebQeury"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.name = QryName Then
-            WebQuery.delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-Attribute CreateCommandBar.VB_ProcData.VB_Invoke_Func = "R\n14"
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Contents"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 49
-                        .OnAction = "cmHelpContents"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim curdate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    curdate = year * 10000
-    curdate = curdate + month * 100
-    curdate = curdate + day
-    If curdate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mTool
->>>>>>
-Attribute VB_Name = "mTool"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub tool_delete_all_tables()
-    QryDelete ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range("A1")
-End Sub
-
-Sub tool_delete_all_charts(theSheet As Worksheet)
-    Dim theChart As Chart
-    For Each theChart In theSheet
-        theChart.Unprotect
-        theChart.delete
-    Next
-End Sub
-
-Sub DateTimeTest()
-    Dim the_date
-    Dim the_time
-    the_date = DateValue(Now)
-    the_time = TimeValue(Now)
-End Sub
-
-
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{760A52A9-8475-11D2-B33C-525400DB02FE}{760A529E-8475-11D2-B33C-525400DB02FE}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-
-
-Private Sub App_WorkbookOpen(ByVal wb As Workbook)
-    Dim wbname As String
-    If Application.Workbooks.count > 1 Then
-        wbname = wb.FullName
-        wb.Close Savechanges:=False
-        Shell "EXCEL " & wbname
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-Project Name : 'Denmark_method'
-Quirk - duff tag length======================
-MGetWebData
->>>>>>
-Attribute VB_Name = "MGetWebData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Const QueryDataName As String = "ExternalDenmarkData"
-
-Function UpdateHistoryFromWeb(wb As Workbook) As Boolean
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim QryPathStr As String
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    UpdateHistoryFromWeb = False
-    QryPathStr = GetQryPath(wb)
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            DestRangeName = .Range("DEN_SYMBOL")
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW")
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = IsNumeric(.Range("DEN_TIME"))
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            .Range(PRICE_TABLE) = DestRangeName
-            'Clear table and temp area
-            With .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE))
-                .ClearContents
-                .NumberFormat = "General"
-            End With
-            
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            If Not QryExist(Location, QueryDataName) Then
-                QryCreate Location, QueryDataName, QryPathStr
-            Else
-                QryRefresh Location, QueryDataName, QryPathStr
-            End If
-            With Location.Worksheet.QueryTables(QueryDataName)
-                DestRangeName = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-    
-'            .Parent.Application.DisplayAlerts = False
-    
-            If ResultLength < denWindow Then
-                Exit Function
-            End If
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                OtherChar:="|", _
-                FieldInfo:=Array( _
-                                Array(1, 9), _
-                                Array(2, 2), _
-                                Array(3, 1), _
-                                Array(4, 1), _
-                                Array(5, 1), _
-                                Array(6, 1), _
-                                Array(7, 1), _
-                                Array(8, 9), _
-                                Array(9, 9), _
-                                Array(10, 9), _
-                                Array(11, 9), _
-                                Array(12, 9))
-            
-            .Range(DestRangeName).EntireColumn.AutoFit
-            
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).NumberFormat = "General"
-            
-            Dim RawData As Range
-            Dim row_idx As Integer
-            
-            Set RawData = .Range(DestRangeName).Offset(0, 1)
-            RawData.Insert Shift:=xlToRight
-            
-            If Not IsIntraday Then
-                Set RawData = RawData.Offset(0, -1)
-                RawData.Value = "18:00"
-                RawData.Cells(1, 1).FormulaR1C1 = "TIME"
-                Set RawData = RawData.Offset(0, -1)
-            Else
-                Set RawData = RawData.Offset(0, -2)
-                RawData.TextToColumns _
-                    Destination:=RawData, _
-                    DataType:=xlDelimited, _
-                    TextQualifier:=xlDoubleQuote, _
-                    ConsecutiveDelimiter:=False, _
-                    Tab:=False, _
-                    Semicolon:=False, _
-                    Comma:=False, _
-                    Space:=True, _
-                    Other:=False, _
-                    OtherChar:="/", _
-                    FieldInfo:=Array( _
-                                    Array(1, 2), _
-                                    Array(2, 2))
-                RawData.Cells(1, 2).FormulaR1C1 = "TIME"
-            End If
-            
-'            Dim end_date As Date
-'            end_date = RawData.Cells(ResultLength, 1).FormulaR1C1
-
-' Delete unused space
-            
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + ResultLength, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            Dim i As Integer
-' Delete blank intervals
-            
-            Set RawData = .Range(RAW_DATA_RANGE).Offset(0, 0)
-            row_idx = 0
-            For i = 1 To ResultLength
-                ' skip virtual prices
-                If RawData.Offset(row_idx, CLOSE_IDX).Value > MIN_PRICE_VALUE Then
-                    row_idx = row_idx + 1
-                Else
-                    Set Location = .Range( _
-                            .Cells(row_idx + RAW_DATA_RANGE_ROW, DATE_IDX + RAW_DATA_RANGE_COL), _
-                            .Cells(row_idx + RAW_DATA_RANGE_ROW, PROJECT_IDX + RAW_DATA_RANGE_COL) _
-                    )
-                    Location.Delete xlShiftUp
-                End If
-            Next i
-            
-            ResultLength = GetLinesCount(.Range(RAW_DATA_RANGE))
-            
-            row_idx = ResultLength - 1
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).Delete xlShiftUp
-            Else
-                Exit Function
-            End If
-            
-            Dim TmpStr As String
-                        
-            row_idx = GetLinesCount(.Range(RAW_DATA_RANGE))
-            
-            Set RawData = .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx - 1, RAW_DATA_RANGE_COL + DATE_IDX) _
-                )
-            RawData.TextToColumns _
-                Destination:=.Range(RAW_DATA_RANGE).Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="-", _
-                FieldInfo:=Array( _
-                                Array(1, 2), _
-                                Array(2, 2), _
-                                Array(3, 2))
-            
-            Set Location = .Range(RAW_DATA_RANGE).Offset(0, -1)
-            
-            If IsIntraday Then
-                Set RawData = .Range( _
-                            .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + TIME_IDX), _
-                            .Cells(RAW_DATA_RANGE_ROW + row_idx - 1, RAW_DATA_RANGE_COL + TIME_IDX) _
-                    )
-                RawData.TextToColumns _
-                    Destination:=.Range(RAW_DATA_RANGE).Offset(0, TIME_STAMP_OFFSET), _
-                    DataType:=xlDelimited, _
-                    TextQualifier:=xlDoubleQuote, _
-                    ConsecutiveDelimiter:=False, _
-                    Tab:=False, _
-                    Semicolon:=False, _
-                    Comma:=False, _
-                    Space:=False, _
-                    Other:=True, _
-                    OtherChar:=":", _
-                    FieldInfo:=Array( _
-                                    Array(1, 2), _
-                                    Array(2, 2), _
-                                    Array(3, 2))
-                                    
-                
-                For i = 0 To row_idx - 1
-                    Location.Offset(i, 0) = "'" & _
-                            .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 1).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 2).Value _
-                            & "-" & .Range(RAW_DATA_RANGE).Offset(i, TIME_STAMP_OFFSET).Value _
-                            & ":" & .Range(RAW_DATA_RANGE).Offset(i, TIME_STAMP_OFFSET + 1).Value
-                Next
-            Else
-                For i = 0 To row_idx - 1
-                    Location.Offset(i, 0) = "'" & _
-                            .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 2).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET + 1).Value _
-                            & "/" & .Range(RAW_DATA_RANGE).Offset(i, DATE_STAMP_OFFSET).Value
-                Next
-            End If
-            .Parent.Application.DisplayAlerts = True
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromWeb = True
-End Function
-
-Private Function GetQryPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    Dim IsIntradai As Boolean
-    Dim DayCount As Integer
-    Const DataFormat As String = "&data_format=BROWSER"
-    With wb.Worksheets(VAR_SHEET)
-        IsIntradai = IsNumeric(.Range("DEN_TIME"))
-        
-        If IsIntradai Then
-        
-            QryPathStr = "URL;http://export.rbc.ru/export/"
-            QryPathStr = QryPathStr & .Range("DEN_SOURCE")
-            QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-            QryPathStr = QryPathStr & "/?"
-            
-            QryPathStr = QryPathStr & "tickers=" & .Range("DEN_SYMBOL")
-            QryPathStr = QryPathStr & "&period=" & .Range("DEN_TIME")
-            QryPathStr = QryPathStr & "&virtual=PASS"
-            DayCount = .Range("DEN_HISTORY") * .Range("DEN_TIME") \ 420 + 1
-            QryPathStr = QryPathStr & "&lastdays=" & DayCount
-            QryPathStr = QryPathStr & "&separator=,"
-            QryPathStr = QryPathStr & DataFormat
-            QryPathStr = QryPathStr & "&header=1"
-        Else
-            QryPathStr = "URL;http://export.rbc.ru/cgi-bin/export/query_version/export.cgi?"
-            QryPathStr = QryPathStr & "&sourcename=" & .Range("DEN_SOURCE")
-            QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-            QryPathStr = QryPathStr & "&tickers=" & .Range("DEN_SYMBOL")
-            QryPathStr = QryPathStr & "&period=DAILY"
-            QryPathStr = QryPathStr & "&virtual=PASS"
-            QryPathStr = QryPathStr & "&lastdays=" & .Range("DEN_HISTORY") + 1
-            QryPathStr = QryPathStr & "&separator=,"
-            QryPathStr = QryPathStr & DataFormat
-            QryPathStr = QryPathStr & "&header=1"
-        End If
-    .Range("LAST_HIST_QRY") = QryPathStr
-    End With
-    GetQryPath = QryPathStr
-End Function
-
-Sub UpdateTickerList(wb As Workbook)
-    Dim Idx, n As Integer
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim QryPathStr As String
-    Dim QueryDataName As String
-    Dim DestRangeArea As String
-    
-    QryPathStr = GetListPath(wb)
-    With wb
-        With .Worksheets(VAR_SHEET)
-            Idx = .Range("IDX_DEN_LIST")
-            Set Location = .Range("TICKER_TABLES").Offset(0, (Idx - 1) * 2)
-             .Range("IDX_DEN_SYMBOL") = 1
-            QueryDataName = Location.Offset(0, 0)
-            'Clear table
-            .Range(Location.Offset(1, 0), Location.Offset(65535 - Location.Row, 1)).ClearContents
-            
-            If Not QryExist(Location.Offset(1, 0), QueryDataName) Then
-                QryCreate Location.Offset(1, 0), QueryDataName, QryPathStr
-            Else
-                QryRefresh Location.Offset(1, 0), QueryDataName, QryPathStr
-            End If
-            
-            With .QueryTables(QueryDataName)
-                DestRangeArea = .ResultRange.Name.RefersTo
-                ResultLength = .ResultRange.count
-            End With
-        
-            .Parent.Application.DisplayAlerts = False
-                
-            .Range(DestRangeArea).TextToColumns _
-                Destination:=.Range(DestRangeArea), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9))
-        ' Sort Data
-            Set Location = .Range(.Range(DestRangeArea).Offset(0, 0), .Range(DestRangeArea).Offset(ResultLength - 1, 1))
-            Location.Sort _
-                Key1:=.Range(DestRangeArea).Offset(0, 0), _
-                Order1:=xlAscending, _
-                Header:=xlNo, _
-                OrderCustom:=1, _
-                MatchCase:=False, _
-                Orientation:=xlTopToBottom
-        End With
-        ' Setup Ticker List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        ' Setup Name List
-         With .Worksheets(VAR_SHEET)
-            DestRangeArea = .Name & "!" & .Range(.Range(DestRangeArea).Cells(1, 1), .Range(DestRangeArea).Cells(ResultLength - 1, 1)).Offset(0, 1).Address
-         End With
-        With .Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat
-            .ListFillRange = DestRangeArea
-            .ListIndex = 1
-        End With
-        .Parent.Application.DisplayAlerts = True
-    End With
-End Sub
-
-Private Function GetListPath(wb As Workbook) As String
-    Dim QryPathStr As String
-    With wb.Worksheets(VAR_SHEET)
-        QryPathStr = "URL;http://export.rbc.ru/cgi-bin/export/tickers.cgi?"
-        QryPathStr = QryPathStr & "&source=" & .Range("DEN_SOURCE")
-        QryPathStr = QryPathStr & "." & .Range("DEN_BOARD")
-        .Range("LAST_DIR_QRY") = QryPathStr
-    End With
-    GetListPath = QryPathStr
-End Function
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            ThisWorkbook.Save
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(FORM_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-mReadWrite
->>>>>>
-Attribute VB_Name = "mReadWrite"
-Option Explicit
-
-Public Const GOOD_LINE_STATUS As String = "Ok"
-Public Const BAD_LINE_STATUS As String = "N/A"
-
-Function ReadPricesData(Location As Range, Hist As Integer, dt As Integer, _
-              pPriceData As TPriceData) As Integer
-    '������������� ���� TPriceData �� ������� ���� - 1
-    'k��������� �� ����� ��� hist ��������� �����
-    'aPoint - ������ �������
-    '������ ��� ������ ������� �������������� ������ (������)
-    Dim n, i As Integer
-    
-    '����������� ����� ����� ������� - n
-    n = GetLinesCount(Location)
-    ReadPricesData = n
-    If n < 9 Then             '���������� ������ !!!
-        GoTo done
-    End If
-    ' ����� ����� ���������� ()
-    If Hist > (n - 3) \ dt + 1 Then ' ��������� �������
-        Hist = (n - 3) \ dt + 1 '
-    End If
-    Dim t, s As Integer
-    For t = 0 To Hist - 1
-        s = n - t * dt - 1
-        pPriceData.D(Hist - t) = Location.Offset(s, DATE_IDX).Value
-        pPriceData.Tm(Hist - t) = Location.Offset(s, TIME_IDX).Value
-        pPriceData.Opn(Hist - t) = Location.Offset(s, OPEN_IDX).Value
-        pPriceData.Hgh(Hist - t) = Location.Offset(s, HIGH_IDX).Value
-        pPriceData.Lw(Hist - t) = Location.Offset(s, LOW_IDX).Value
-        pPriceData.Cls(Hist - t) = Location.Offset(s, CLOSE_IDX).Value
-        pPriceData.Vl(Hist - t) = Location.Offset(s, VOLUME_IDX).Value
-    Next t
-    ReadPricesData = t + 1
-done:
-End Function
-
-Sub ResultLinesOut(Location As Range, pPD As TPriceData, pDen As TDenmark)
-    Dim n As Integer
-    
-    n = GetLinesCount(Location)
-    With Location
-        .Offset(-1, RESIST_IDX) = "Resistance"
-        .Offset(-1, SUPPORT_IDX) = "Support"
-        .Offset(-1, PROJECT_IDX) = "Project"
-    End With
-    Dim t, count, Idx, loc_idx As Integer
-    count = pPD.tC
-    For t = 0 To count - 1
-        Idx = count - t
-        loc_idx = n - t - 1
-        If pDen.ResistanceLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, RESIST_IDX).Value = pDen.ResistanceLine(Idx)
-        End If
-        If pDen.SupportLine(Idx) > MIN_PRICE_VALUE Then
-            Location.Offset(loc_idx, SUPPORT_IDX).Value = pDen.SupportLine(Idx)
-        End If
-        If Abs(pDen.SignalValue) > 1 Then
-            Location.Offset(loc_idx, PROJECT_IDX).Value = pDen.ProjectPrice
-        End If
-    Next t
-End Sub
-
-Sub Out_Table_1(TheRange As Range, pDen As TDenmark, LastIdx As Integer)
-    
-    
-    ' Col = 2 - �� ��������� !!!
-    ' Status - Col = 0
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(0, 0).Value = BAD_LINE_STATUS
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 0).Value = GOOD_LINE_STATUS
-    Else
-        TheRange.Offset(1, 0).Value = BAD_LINE_STATUS
-    End If
-    ' -----------------------------------------
-    ' ���� �������� ����� ������������� � ��������� - Col = 1
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 1).Value = pDen.ResistanceAngle
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 1).Value = pDen.SupportAngle
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 1).Value = (pDen.ResistanceAngle + pDen.SupportAngle) / 2
-    End If
-    ' -----------------------------------------
-    ' ������� ���� ����� �������� �� ������� ������
-    If pDen.ResistancePointCount >= 2 Then
-        TheRange.Offset(0, 2).Value = pDen.ResistanceLine(LastIdx)
-    End If
-    If pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(1, 2).Value = pDen.SupportLine(LastIdx)
-    End If
-    If pDen.ResistancePointCount >= 2 And pDen.SupportPointsCount >= 2 Then
-        TheRange.Offset(2, 2).Value = _
-            (pDen.ResistanceLine(LastIdx) + pDen.SupportLine(LastIdx)) / 2
-    End If
-    
-End Sub
-
-Sub Out_Table_2(TheRange As Range, TheComment As Range, pPD As TPriceData, pDen As TDenmark)
-    Const ColorIndexBUY = 5
-    Const ColorIndexSELL = 3
-    Const ColorIndexNOTHINK = 14
-    
-    Dim SignalValue_defined, allert_enable  As Boolean
-    Dim Message As String
-    SignalValue_defined = False
-    allert_enable = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_ALLERT_DLG")
-    Message = "������ �� ��������� ������ �� ���������������."
-    If pDen.SignalValue >= 2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "BUY"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexBUY
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue - 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "BUY Signal: �������� ������ ����� ����������� ������ � ������� ���������� = " & pDen.SignalValue - 1 & " ! "
-    End If
-    If pDen.SignalValue <= -2 Then
-        SignalValue_defined = True
-        With TheRange.Offset(0, 0)
-            .Value = "SELL"
-            .Font.Bold = True
-            .Font.ColorIndex = ColorIndexSELL
-        End With
-        TheRange.Offset(0, 1).Value2 = pPD.D(pPD.tC)
-        TheRange.Offset(0, 2).Value2 = pPD.Tm(pPD.tC)
-        TheRange.Offset(0, 3).Value = pDen.SignalValue + 1
-        TheRange.Offset(0, 4).Value = pDen.ProjectPrice
-        Message = "SELL Signal: �������� ������ ���� ����������� ������ � ������� ���������� = " & -(pDen.SignalValue + 1) & "!"
-    End If
-    With TheComment
-        .Value = Message
-        .Font.Bold = True
-        Dim color_idx As Integer
-        If SignalValue_defined Then
-            If pDen.SignalValue > 0 Then
-                .Font.ColorIndex = ColorIndexBUY
-            Else
-                .Font.ColorIndex = ColorIndexSELL
-            End If
-        Else
-            .Font.ColorIndex = ColorIndexNOTHINK
-        End If
-    End With
-    If allert_enable And SignalValue_defined Then
-        MsgBox _
-            Prompt:=Message, _
-            Title:=PROGRAM_NAME, _
-            Buttons:=vbOKOnly + vbInformation
-    End If
-End Sub
-
-Sub Out_Table_3(TheRange As Range, pDen As TDenmark)
-    Dim i As Integer
-    For i = 1 To 3
-        TheRange.Offset(i - 1, 0).Value = pDen.Qualificator(i)
-    Next i
-End Sub
-
-Sub Out_Table_4(TheRange As Range, pPD As TPriceData)
-    Dim LastIdx As Integer
-    LastIdx = pPD.tC
-    With TheRange
-        .Offset(0, 0).Value2 = "'" & pPD.D(LastIdx)
-        .Offset(0, 1).Value2 = "'" & pPD.Tm(LastIdx)
-        .Offset(0, 2) = pPD.Opn(LastIdx)
-        .Offset(0, 3) = pPD.Hgh(LastIdx)
-        .Offset(0, 4) = pPD.Lw(LastIdx)
-        .Offset(0, 5) = pPD.Cls(LastIdx)
-        .Offset(0, 6) = pPD.Cls(LastIdx) - pPD.Cls(LastIdx - 1)
-    End With
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Denmark method bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-    End With
-    CreateCommandBar theApp:=wb.Application
-End Sub
-
-Sub RestoreEnvironment(wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(FORM_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(wb As Workbook)
-    With wb
-        .Application.ScreenUpdating = False
-        
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Protect Password:=common_pwd, userInterfaceOnly:=True, Contents:=False
-        End With
-        With .Worksheets(FORM_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-            .Select
-        End With
-        With .Worksheets(CHART_SHEET)
-            .EnableSelection = xlNoSelection
-            .Protect userInterfaceOnly:=True
-        End With
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(wb As Workbook)
-    With wb
-        .Unprotect
-        .Application.ScreenUpdating = False
-        With .Worksheets(RAW_DATA_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(VAR_SHEET)
-            .Visible = xlVeryHidden
-            .Unprotect Password:=common_pwd
-        End With
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Unprotect
-        End With
-        With .Worksheets(FORM_SHEET)
-            .Select
-            .Unprotect
-        End With
-        .Application.ScreenUpdating = True
-        
-    End With
-End Sub
-
-<<<<<<
-======================
-mTypes
->>>>>>
-Attribute VB_Name = "mTypes"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "����� �-�� ������� II"
-Public Const PROGRAM_VERSION As String = "version 4.3 Professional"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-Public Const ESTIMATION_DATE As Long = 20011215
-'Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "J27"
-
-Public Const RAW_DATA_SHEET As String = "Raw_data"
-Public Const PRICE_TABLE As String = "B1"
-Public Const RAW_DATA_RANGE As String = "B3"
-Public Const RAW_DATA_RANGE_COL As Integer = 2
-Public Const RAW_DATA_RANGE_ROW As Integer = 3
-
-Public Const VAR_SHEET As String = "Var_s"
-
-Public Const CHART_SHEET As String = "Chart"
-
-Public Const MIN_PRICE_VALUE As Double = 0.000001
-Public Const MAX_PRICE_VALUE As Double = 1000000000
-
-' Fields indexes in RAW_DATA_RANGE
-Public Const DATE_IDX As Integer = 0
-Public Const TIME_IDX As Integer = 1
-Public Const OPEN_IDX As Integer = 2
-Public Const HIGH_IDX As Integer = 3
-Public Const LOW_IDX As Integer = 4
-Public Const CLOSE_IDX As Integer = 5
-Public Const VOLUME_IDX As Integer = 6
-Public Const RESIST_IDX As Integer = 7
-Public Const SUPPORT_IDX As Integer = 8
-Public Const PROJECT_IDX As Integer = 9
-
-Public Const DATE_STAMP_OFFSET = PROJECT_IDX + 1
-Public Const TIME_STAMP_OFFSET = PROJECT_IDX + 4
-Public Const DATE_TIME_STAMP_SIZE = 5
-
-Type TPriceData
-    D() As String      ' ����������� ����
-    Tm() As String     ' �����
-    Opn() As Double    ' Open
-    Hgh() As Double    ' High
-    Lw() As Double     ' Low
-    Cls() As Double    ' Close
-    Vl() As Double     ' Volume
-    tC As Integer      ' Current time
-End Type
-
-Type TDenmark
-   ResistanceLine() As Double           'Resistance line
-   ResistancePoints() As Integer        'Resistance pivot points
-   ResistancePointCount As Integer      'The number of resistance pivot points
-   ResistanceAngle As Double            'Angle of Declination of ResistanceLine
-   
-   SupportLine() As Double              'Support line
-   SupportPoints() As Integer           'Support pivot points
-   SupportPointsCount As Integer        'The number of support pivot points
-   SupportAngle As Double               ' Angle of Declination of SupportLine
-   
-   SignalParameter     As Integer       ' parameter for SignalValue
-   SignalValue      As Integer          'SignalValue
-   
-   
-   Qualificator(1 To 3) As String       ' qualificators
- 
-   ProjectNumber As Integer             ' ����� ��������
-   ProjectPrice  As Double              ' �������� ����
-   
-End Type
-
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-Dim AppRunEnable As New cEnableRun
-
-
-Sub cmViewChart(Optional SwapPage As Boolean = True)
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_CHART_READY") = False
-        If .Range("BOOL_DEMARK_READY") <> True Then
-            If .Range("BOOL_AUTORECALC") = True Then
-                evSubmit_Click
-                If .Range("BOOL_DEMARK_READY") <> True Then
-                    Exit Sub
-                End If
-            Else
-                MsgBox _
-                    "������ �� ����� ���� ��������." & vbCrLf & "�������� ������ �� ����������.", _
-                    vbOKOnly + vbExclamation, _
-                    PROGRAM_NAME
-                Exit Sub
-            End If
-        End If
-    End With
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        With .Range("TABLE_1")
-            Dim test_lines As Boolean
-            test_lines = StrComp(.Cells(1, 1).Value, GOOD_LINE_STATUS)
-            test_lines = test_lines + StrComp(.Cells(2, 1).Value, GOOD_LINE_STATUS)
-            If test_lines <> 0 Then
-                MsgBox _
-                    Prompt:="������ �� ����� ���� ��������." & vbCrLf & "������� ����� �� ���������� .", _
-                    Title:=PROGRAM_NAME, _
-                    Buttons:=vbOKOnly + vbExclamation
-                Exit Sub
-            End If
-        End With
-        Draw_Chart Not IsEmpty(.Range("TABLE_2").Cells(1, 1))
-    End With
-    With ThisWorkbook
-        .Worksheets(VAR_SHEET).Range("BOOL_CHART_READY") = True
-        If SwapPage Then
-            .Worksheets(CHART_SHEET).Select
-        End If
-    End With
-End Sub
-
-Sub cmViewForm()
-    With ThisWorkbook
-        .Worksheets(FORM_SHEET).Select
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Dim ResistanceLine
-    ResistanceLine = MsgBox( _
-        Prompt:="�� ������� ��������� ���������?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If ResistanceLine = vbYes Then
-       Application.Quit
-    End If
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Demark.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable wb:=ThisWorkbook
-    SetEnvironment wb:=ThisWorkbook
-    ProtectionEnable wb:=ThisWorkbook
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable wb:=ThisWorkbook
-        RestoreEnvironment wb:=ThisWorkbook, DesignMode:=True
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmPrint()
-    If MsgBox( _
-            Prompt:="�� ������� ����������� ���������?", _
-            Buttons:=vbYesNo + vbQuestion, _
-            Title:=PROGRAM_NAME) = vbNo _
-    Then
-        Exit Sub
-    End If
-    Dim s_ticker, s_name, s_time As String
-    s_ticker = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME")
-    s_name = ThisWorkbook.Worksheets(FORM_SHEET).Range("CALC_NAME")
-    s_time = Now
-    Application.ScreenUpdating = False
-    cmViewChart SwapPage:=False
-    Application.ScreenUpdating = False
-    With ThisWorkbook.Worksheets(FORM_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    With ThisWorkbook.Worksheets(CHART_SHEET).PageSetup
-        .LeftHeader = s_ticker
-        .CenterHeader = PROGRAM_NAME
-        .RightHeader = s_time
-        .LeftFooter = s_name
-        .CenterFooter = "Page &P of &N"
-        .RightFooter = ""
-        .LeftMargin = Application.InchesToPoints(0.75)
-        .RightMargin = Application.InchesToPoints(0.75)
-        .TopMargin = Application.InchesToPoints(0.78)
-        .BottomMargin = Application.InchesToPoints(0.92)
-        .HeaderMargin = Application.InchesToPoints(0.5)
-        .FooterMargin = Application.InchesToPoints(0.5)
-        .PrintHeadings = False
-        .PrintGridlines = False
-        .PrintComments = xlPrintNoComments
-        .CenterHorizontally = False
-        .CenterVertically = False
-        .Orientation = xlPortrait
-        .Draft = False
-        .PaperSize = xlPaperA4
-        .FirstPageNumber = xlAutomatic
-        .Order = xlDownThenOver
-        .BlackAndWhite = False
-        .Zoom = False
-        .FitToPagesWide = 1
-        .FitToPagesTall = 2
-    End With
-    Application.ScreenUpdating = False
-    ThisWorkbook.Worksheets(Array("MainForm", "Chart")).PrintOut Copies:=1, Collate:=True
-    cmViewForm
-End Sub
-<<<<<<
-======================
-mDemark
->>>>>>
-Attribute VB_Name = "mDemark"
-Option Explicit
-
-Public Const FORM_SHEET As String = "MainForm"
-
-'Form Ranges
-Public Const FILE_NAME As String = "FILE_NAME"
-Public Const TABLE_1 As String = "TABLE_1"
-Public Const TABLE_2 As String = "TABLE_2"
-Public Const TABLE_3 As String = "TABLE_3"
-Public Const TABLE_4 As String = "TABLE_4"
-Public Const TABLE_COMMENT As String = "TABLE_COMMENT"
-
-'�������� ��� ������ - �������� 1
-
-'*********************
-Dim PriceDataArray As TPriceData
-Dim DenmarkDataArray As TDenmark
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Sub ClearResultTables()
-    With ThisWorkbook.Worksheets(FORM_SHEET)
-        .Range(TABLE_1).ClearContents ' �������-1
-        .Range(TABLE_2).ClearContents ' �������-2
-        .Range(TABLE_3).ClearContents ' �������-3
-        .Range(TABLE_COMMENT).Value = "" ' ����������-3
-        .Range(TABLE_4).ClearContents ' �������-4
-    End With
-End Sub
-
-Function TDenmark_Calc() As Boolean
-    
-    Dim nWindow As Integer
-    Dim bPrevCloseFilter, bSuccCloseFilter As Boolean
-    
-    TDenmark_Calc = False
-    
-    mobjAppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    With ThisWorkbook
-        .Application.ScreenUpdating = False
-'1)    Read User data
-        With .Worksheets(VAR_SHEET)
-            DenmarkDataArray.ProjectNumber = .Range("DEN_PROECT").Value
-            DenmarkDataArray.SignalParameter = .Range("DEN_PARAM").Value
-            nWindow = .Range("DEN_WINDOW").Value
-            bPrevCloseFilter = .Range("BOOL_PREV_CLOSE").Value
-            bSuccCloseFilter = .Range("BOOL_SUCC_CLOSE").Value
-        End With
-
-'2)   Memory allocation
-        allocate_memory PriceDataArray, DenmarkDataArray, nWindow
-
-'3)   Read data
-        Dim TheRange As Range
-        Set TheRange = .Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE)
-        Dim LinesCount As Integer
-        LinesCount = ReadPricesData(Location:=TheRange, Hist:=PriceDataArray.tC, dt:=1, pPriceData:=PriceDataArray)
-        
-        'Init function result
-        TDenmark_Calc = LinesCount >= nWindow
-        
-        If LinesCount >= nWindow Then
-        
-'4)   Calculate metod TDenmarkDataArray
-            DetDenmark PriceDataArray, DenmarkDataArray, bPrevCloseFilter, bSuccCloseFilter
-            If Abs(DenmarkDataArray.SignalValue) > 1 Then  '������� ���������, ���� ���� ������
-                DetProj PriceDataArray, DenmarkDataArray
-            End If
-'5)   Write result
-            Application.ScreenUpdating = False
-    
-'6)    Clear interface tables
-            ClearResultTables
-            
-            ResultLinesOut Location:=TheRange.Offset(2, 0), pPD:=PriceDataArray, pDen:=DenmarkDataArray
-            
-            With .Worksheets(FORM_SHEET)
-                Out_Table_1 TheRange:=.Range(TABLE_1).Cells(1, 1), pDen:=DenmarkDataArray, LastIdx:=PriceDataArray.tC
-                Out_Table_2 _
-                        TheRange:=.Range(TABLE_2).Cells(1, 1), _
-                        TheComment:=.Range("TABLE_COMMENT"), _
-                        pPD:=PriceDataArray, _
-                        pDen:=DenmarkDataArray
-                Out_Table_3 TheRange:=.Range(TABLE_3).Cells(1, 1), pDen:=DenmarkDataArray
-                Out_Table_4 TheRange:=.Range(TABLE_4).Cells(1, 1), pPD:=PriceDataArray
-                With .Range(TABLE_1)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_2)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_3)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-                With .Range(TABLE_4)
-                    .Font.Name = "Arial"
-                    .Font.Size = 9
-                    .HorizontalAlignment = xlCenter
-                    .VerticalAlignment = xlCenter
-                    .WrapText = False
-                    .Orientation = 0
-                    .ShrinkToFit = False
-                    .MergeCells = False
-                End With
-            End With
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = True
-        Else
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-'7)   Free unused memory
-        free_unused_memory PriceDataArray, DenmarkDataArray
-    End With
-End Function
-
-Sub allocate_memory(pPriceData As TPriceData, pDenmarkData As TDenmark, memsize As Integer)
-'  ������ ��� TDenmark
-    ReDim pDenmarkData.ResistanceLine(1 To memsize)
-    ReDim pDenmarkData.ResistancePoints(1 To memsize)
-    ReDim pDenmarkData.SupportLine(1 To memsize)
-    ReDim pDenmarkData.SupportPoints(1 To memsize)
-   
-' ������������� ������ �� �����
-    pPriceData.tC = memsize
-    ReDim pPriceData.D(1 To memsize)
-    ReDim pPriceData.Tm(1 To memsize)
-    ReDim pPriceData.Opn(1 To memsize)
-    ReDim pPriceData.Hgh(1 To memsize)
-    ReDim pPriceData.Lw(1 To memsize)
-    ReDim pPriceData.Cls(1 To memsize)
-    ReDim pPriceData.Vl(1 To memsize)
-
-End Sub
-
-Sub free_unused_memory(pP As TPriceData, pD As TDenmark)
-'   Free Prices
-    pP.tC = 0
-    Erase pP.D
-    Erase pP.Tm
-    Erase pP.Opn
-    Erase pP.Hgh
-    Erase pP.Lw
-    Erase pP.Cls
-    Erase pP.Vl
-    
-'Free TDenmark
-    Erase pD.ResistanceLine
-    Erase pD.ResistancePoints
-    Erase pD.SupportLine
-    Erase pD.SupportPoints
-End Sub
-
-
-'*****************************************
-Sub DetDenmark(pPriceData As TPriceData, pDenmarkData As TDenmark, ByVal ClosePrev2 As Boolean, ByVal CloseSucc1 As Boolean)
-' ����������� ��������� ������ �������� (� �������� �����)
-' �� ������� ������ ������� ������� tC
-' �������� ������:
-' pPriceData  - ����, ����������� ����� ������ �� ����� (����������)
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' pDenmarkData - �������� ������ �������� (������ ��������, SignalParameter - ���������):
-' ����� ResistanceLine,SupportLine �� �������, ������� �����, ������� � ������� ��� �������
-' SignalValue = 0 ������ �����������
-' SignalValue < 0 ������ ����������� ������ (������ �������)
-' SignalValue > 0 ������ ����������� ������ (������ �������)
-' ���� pDenmarkData.ResistancePointCount < 2, �� �������� ResistanceLine �� ������������
-' ���� pDenmarkData.SupportPointsCount < 2, �� �������� SupportLine �� ������������
-
-' ��������� ���������
-    Const QUALIFICATOR_DISABLE As String = "-"
-    Const QUALIFICATOR_ENABLE As String = "Signal"
-    
-    Dim UpQual(1 To 3) As String
-    Dim DownQual(1 To 3) As String
-    Dim UpSignal, DownSignal As Integer
-    Dim i As Integer
-    
-    pDenmarkData.SignalValue = 0
-    UpSignal = 0
-    DownSignal = 0
-    
-    For i = 1 To 3
-        pDenmarkData.Qualificator(i) = QUALIFICATOR_DISABLE
-        UpQual(i) = QUALIFICATOR_DISABLE
-        DownQual(i) = QUALIFICATOR_DISABLE
-    Next i
-    
-' ����������� ����� ��������� � �������������
-    ResLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.ResistancePointCount, _
-        pDenmarkData.ResistanceLine, _
-        pDenmarkData.ResistancePoints, _
-        ClosePrev2, _
-        CloseSucc1
-        
-    SuppLine _
-        pPriceData, _
-        pPriceData.tC, _
-        pDenmarkData.SupportPointsCount, _
-        pDenmarkData.SupportLine, _
-        pDenmarkData.SupportPoints, _
-        ClosePrev2, _
-        CloseSucc1
-
-        
-        
-    If pDenmarkData.ResistancePointCount >= 2 Then
-        pDenmarkData.ResistanceAngle = 57.29578 * _
-            Atn(pDenmarkData.ResistanceLine(pPriceData.tC) - _
-                pDenmarkData.ResistanceLine(pPriceData.tC - 1))
-    End If
-    If pDenmarkData.SupportPointsCount >= 2 Then
-        pDenmarkData.SupportAngle = 57.29578 * _
-            Atn(pDenmarkData.SupportLine(pPriceData.tC) - _
-                pDenmarkData.SupportLine(pPriceData.tC - 1))
-    End If
-
-' ������������ ������� ----------------------------------
-    Dim t As Integer
-' 1. ������ ����������� ������: ResistanceLine ��������� � ResistanceLine ������ *************
-    If pDenmarkData.ResistancePointCount >= 2 And pDenmarkData.ResistanceAngle < 0 Then
-'    ����������� ������� ������� �����
-        If pDenmarkData.ResistanceLine(pPriceData.tC) < pPriceData.Cls(pPriceData.tC) Then
-            UpSignal = 1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) > pDenmarkData.ResistanceLine(t) Then
-                    UpSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If UpSignal = 1 Then
-'       Qualificator-1: close ������� �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) > pPriceData.Cls(pPriceData.tC - 1) Then
-                UpSignal = UpSignal + 1
-                UpQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: open > ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) > pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - demand value < ResistanceLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Lw(pPriceData.tC - 1) < pDenmarkData.ResistanceLine(pPriceData.tC) Then
-                UpSignal = UpSignal + 1
-                UpQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-    End If  ' ���������� ����� ��������� ************************************
-
-' 2. ������ ����������� ������: SupportLine ��������� � SupportLine ������
-    If pDenmarkData.SupportPointsCount >= 2 And pDenmarkData.SupportAngle > 0 Then
-'    ---------------------------------------------
-'    ����������� ������� ������� ����
-        If pPriceData.Cls(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-            DownSignal = -1
-            For t = pPriceData.tC - pDenmarkData.SignalParameter To pPriceData.tC - 1
-                If pPriceData.Cls(t) < pDenmarkData.SupportLine(t) Then
-                    DownSignal = 0
-                    Exit For
-                End If
-            Next t
-        End If
-        If DownSignal = -1 Then
-'       Qualificator-1: Close ������ �������� �������
-            If pPriceData.Cls(pPriceData.tC - 2) < pPriceData.Cls(pPriceData.tC - 1) Then
-                DownSignal = DownSignal - 1
-                DownQual(1) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-2: Open ���� ResistanceLine � ������ �������
-            If pPriceData.Opn(pPriceData.tC) < pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(2) = QUALIFICATOR_ENABLE
-            End If
-'       Qualificator-3 - supply value(t-1) > SupportLine(tC)
-            If 2 * pPriceData.Cls(pPriceData.tC - 1) - pPriceData.Hgh(pPriceData.tC - 1) > pDenmarkData.SupportLine(pPriceData.tC) Then
-                DownSignal = DownSignal - 1
-                DownQual(3) = QUALIFICATOR_ENABLE
-            End If
-        End If
-'    ---------------------------------------------
-    End If
-'      ���������� ������������ ���������
-    If Abs(DownSignal) <> UpSignal Then
-        If Abs(DownSignal) > UpSignal Then
-            pDenmarkData.SignalValue = DownSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = DownQual(i)
-            Next i
-        Else
-            pDenmarkData.SignalValue = UpSignal
-            For i = 1 To 3
-                pDenmarkData.Qualificator(i) = UpQual(i)
-            Next i
-        End If
-    End If
-End Sub
-
-Sub DetProj(pPriceData As TPriceData, pDenmarkData As TDenmark)
-'����������� �������� ��� ������� �������: |Signal| > 1
-'�������� ������������ |Signal| > 1 !!!
-    Dim pM As Double, t As Integer, Tm As Integer, tL As Integer
-
-    If pDenmarkData.SignalValue >= 2 Then  ' ������ �������
-
-        tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount)     ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.ResistancePointCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2 Then
-'           t* = Arg min {L(t) : t R <= t  <= tb ,  L(t) < ResistanceLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Lw(Tm) ' L(t-1) < ResistanceLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Lw(t) < pM And pPriceData.Lw(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Lw(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
-'               P1( tb) = ResistanceLine(tb) + ResistanceLine(t*) - L(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Lw(Tm)
-            Else
-                pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If ' pDenmarkData.ProjectNumber >= 1 And pDenmarkData.ProjectNumber <= 2
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg min { �(t) : t R <= t  <= tb ,  C(t) < ResistanceLine(t)}
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Cls(t) < pM And pPriceData.Cls(t) < pDenmarkData.ResistanceLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.ResistanceLine(pPriceData.tC) + pDenmarkData.ResistanceLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue >= 2
-
-'-------------------------------------------------------------------
-'*******************************************************************
-' �������� ��� ������� �������
-    If pDenmarkData.SignalValue <= -2 Then
-        tL = pDenmarkData.SupportPoints(pDenmarkData.SupportPointsCount)  ' tR determination
-        If tL = pPriceData.tC Then
-            tL = pDenmarkData.ResistancePoints(pDenmarkData.SupportPointsCount - 1)
-        End If
-
-'  Projections 1,2 --------------------------------------------
-        If pDenmarkData.ProjectNumber = 1 Or pDenmarkData.ProjectNumber = 2 Then
-'           t* = Arg max {H(t) : t R <= t  <= tb ,  H(t) > SupportLine(t)},
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Hgh(Tm) ' H(t-1) > SupportLine(t-1) for t - break point !
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pPriceData.Hgh(t) > pM And pPriceData.Hgh(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Hgh(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            If pDenmarkData.ProjectNumber = 1 Then
- '              P1( tb) = SupportLine(tb) + SupportLine(t*) - H(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Hgh(Tm)
-            Else
-'               P2( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-                pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-            End If
-        End If
-   
-'  ----------------------------------------------------------------
-'  Projections 3
-        If pDenmarkData.ProjectNumber = 3 Then
-'           t*  = Arg max { �(t) : t R <= t  <= tb ,  C(t) >  SupportLine(t)}
-'           P3( tb) = SupportLine(tb) + SupportLine(t*) - C(t*)
-            Tm = pPriceData.tC - 1
-            pM = pPriceData.Cls(Tm)
-            For t = pPriceData.tC - 2 To tL Step -1
-                If pM < pPriceData.Cls(t) And pPriceData.Cls(t) > pDenmarkData.SupportLine(t) Then
-                    pM = pPriceData.Cls(t): Tm = t
-                End If
-            Next t
-'           t* is defined
-            pDenmarkData.ProjectPrice = pDenmarkData.SupportLine(pPriceData.tC) + pDenmarkData.SupportLine(Tm) - pPriceData.Cls(Tm)
-        End If
-    End If ' pDenmarkData.SignalValue <= -2
-End Sub
-
-Sub ResLine(pP As TPriceData, tE As Integer, ResistancePointCount As Integer, _
-            ResistanceLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ������������� �� ������� [1]
-' �������� �������
-' �������� ������:
-' High, dom(High) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� ResistanceLine, dom(ResistanceLine)=[s(1), tE], �
-' 2) s = {s(1), s(2), ..., s(ResistancePointCount)}, s(1) < s(2) < ...< s(ResistancePointCount)
-'   ( s(ResistancePointCount)<= tE )- ������� �����
-' 3) ����� ������� ����� ResistancePointCount.
-' 4) s(1) -  ������ ������ ������� � �������� ���������� SupportLine
-'    �� ���� dom{Supp} = [s(1), tC]
-' ����. ���� ����� ������� ����� �������� < 2, �� �����
-' ������������� �� ������������. � ���� ������ �������
-' ��������� ������� tE !!!
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-  
-'1 ����������� ������� �������� �������
-    ResistancePointCount = 0
-    For t = 3 To tE - 1
- '      v = max{high(t-1), high(t+1)} < high(t)}
-        v = pP.Hgh(t - 1)
-        If v < pP.Hgh(t + 1) Then
-            v = pP.Hgh(t + 1)
-        End If
-        IsGoodPoint = pP.Hgh(t) > v
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) < pP.Hgh(t))
-        End If
-        
-        If IsGoodPoint Then       'alt.: v >= High(t + 1)
-            s(ResistancePointCount + 1) = t: ResistancePointCount = ResistancePointCount + 1
-        End If
-    Next t
-    
-loop_:
-    
-    If ResistancePointCount < 2 Then
-        GoTo done
-    End If
-
-' 2 ����������� ����� �������������
-    ResistanceLine(s(1)) = pP.Hgh(s(1))
-    For i = 2 To ResistancePointCount
-        ResistanceLine(s(i)) = pP.Hgh(s(i))
-        v = (pP.Hgh(s(i)) - pP.Hgh(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            ResistanceLine(t) = pP.Hgh(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(ResistancePointCount) < tE Then
-        v = (pP.Hgh(s(ResistancePointCount)) - pP.Hgh(s(ResistancePointCount - 1))) / (s(ResistancePointCount) - s(ResistancePointCount - 1))
-        For t = s(ResistancePointCount) + 1 To tE
-            ResistanceLine(t) = pP.Hgh(s(ResistancePointCount - 1)) + v * (t - s(ResistancePointCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To ResistancePointCount
-            If ResistanceLine(s(t) + 1) < pP.Cls(s(t) + 1) Then
-                ResistancePointCount = ResistancePointCount - 1
-                ' ������� �����
-                For i = t To ResistancePointCount
-                    s(i) = s(i + 1)
-                Next i
-                s(ResistancePointCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(ResistanceLine)
-                Rb = UBound(ResistanceLine)
-                Erase ResistanceLine
-                ReDim ResistanceLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-    
-done:
-End Sub
-
-Sub SuppLine(pP As TPriceData, tE As Integer, SupportPointsCount As Integer, _
-               SupportLine() As Double, s() As Integer, ClosePrev2 As Boolean, CloseSucc1 As Boolean)
-' ����������� ����� ��������� �� ������� [1] (�� �����)
-' �������� ������:
-' Low, dom(Low) = [1, tE]
-' ClosePrev2 - H(t) > max{ H(t-1), H(t+1)} �  H(t) > Close(t-2)
-' CloseSucc1 - H(t) > max{ H(t-1), H(t+1)}  �  R(t+1) > Close(t+1)
-' ���������:
-' 1) ����� ������������� SupportLine, dom(SupportLine)=[s(1), tE],
-' 2) s = {s(1), s(2), ..., s(SupportPointsCount)}, s(1) < s(2) < ...< s(SupportPointsCount) -
-'    ������� �����
-' 3) ����� ������� ����� SupportPointsCount.
-' ����. ���� ����������� ����� ������� ����� �������� < 2, �� �����
-' ��������� �� ������������.
-    Dim t As Integer, i As Integer
-    Dim v As Double
-    Dim IsGoodPoint As Boolean
-    
-'1 ����������� ������� �������� �������
-     SupportPointsCount = 0
-    For t = 3 To tE - 1
-'       v = min{Low(t-1), Low(t+1)} > Low(t)
-        v = pP.Lw(t - 1)
-        If v > pP.Lw(t + 1) Then
-            v = pP.Lw(t + 1)
-        End If
-        
-        IsGoodPoint = pP.Lw(t) < v
-        
-        If IsGoodPoint And ClosePrev2 Then
-            IsGoodPoint = IsGoodPoint And (pP.Cls(t - 2) > pP.Lw(t))
-        End If
-        
-        If IsGoodPoint Then     'alt.: v >= High(t + 1)
-            s(SupportPointsCount + 1) = t: SupportPointsCount = SupportPointsCount + 1
-        End If
-    Next t
-
-loop_:
-    If SupportPointsCount < 2 Then
-        GoTo done
-    End If
-' 2 ����������� ����� ���������
-    
-    SupportLine(s(1)) = pP.Lw(s(1))
-    For i = 2 To SupportPointsCount
-        SupportLine(s(i)) = pP.Lw(s(i))
-        v = (pP.Lw(s(i)) - pP.Lw(s(i - 1))) / (s(i) - s(i - 1))
-        For t = s(i - 1) + 1 To s(i) - 1
-            SupportLine(t) = pP.Lw(s(i - 1)) + v * (t - s(i - 1))
-        Next t
-    Next i
-    If s(1) < tE Then
-        v = (pP.Lw(s(SupportPointsCount)) - pP.Lw(s(SupportPointsCount - 1))) / (s(SupportPointsCount) - s(SupportPointsCount - 1))
-        For t = s(SupportPointsCount) + 1 To tE
-            SupportLine(t) = pP.Lw(s(SupportPointsCount - 1)) + v * (t - s(SupportPointsCount - 1))
-        Next t
-    End If
-    If CloseSucc1 Then
-        For t = 1 To SupportPointsCount
-            If SupportLine(s(t) + 1) > pP.Cls(s(t) + 1) Then
-                SupportPointsCount = SupportPointsCount - 1
-                ' ������� �����
-                For i = t To SupportPointsCount
-                    s(i) = s(i + 1)
-                Next i
-                s(SupportPointsCount + 1) = 0
-                ' �������� ������ �����
-                Dim Lb, Rb As Integer
-                Lb = LBound(SupportLine)
-                Rb = UBound(SupportLine)
-                Erase SupportLine
-                ReDim SupportLine(Lb To Rb)
-                GoTo loop_
-            End If
-        Next t
-    End If
-done:
-End Sub
-
-<<<<<<
-======================
-mChart
->>>>>>
-Attribute VB_Name = "mChart"
-Option Explicit
-
-Const CHART_NAME As String = "PriceChart"
-
-Sub Draw_Chart(SignalDefined As Boolean)
-
-    Dim n As Integer
-    Dim theChart As Chart
-    Dim ChartDataAria, szLastNumber As String
-    Dim MinYScale As Double
-    
-    
-    With ThisWorkbook
-' Checking data
-' Disable screen out
-        .Application.Cursor = xlWait
-        .Application.ScreenUpdating = False
-' Create series range
-        n = GetLinesCount(Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE))
-        szLastNumber = n + 1
-        If SignalDefined Then
-            ChartDataAria = "A2:A" & szLastNumber _
-                        & ",D2:D" & szLastNumber _
-                        & ",G2:G" & szLastNumber _
-                        & ",I2:K" & szLastNumber
-        Else
-            ChartDataAria = "A2:A" & szLastNumber _
-                        & ",D2:D" & szLastNumber _
-                        & ",G2:G" & szLastNumber _
-                        & ",I2:J" & szLastNumber
-        End If
-        MinYScale = GetMinValue(.Worksheets(RAW_DATA_SHEET).Range(ChartDataAria))
-' Find and delete old chart
-        .Worksheets(CHART_SHEET).Unprotect
-        Dim WindowWidth, WindowHeight As Integer
-        With .Worksheets(CHART_SHEET)
-            WindowWidth = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            WindowHeight = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-        
-        
-        With .Worksheets(CHART_SHEET).ChartObjects
-            .Delete
-            With .Add(5, 5, WindowWidth - 10, WindowHeight - 10)
-                .SendToBack
-                Set theChart = .Chart
-            End With
-' Create a chart
-        End With
-        With theChart
-            .ChartType = xlLine
-            .SetSourceData Source:=Sheets(RAW_DATA_SHEET).Range( _
-                    ChartDataAria), PlotBy:=xlColumns
-'                   .Location Where:=xlLocationAsObject, Name:=CHART_SHEET
-            .HasTitle = True
-            With .ChartTitle
-                .Text = ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range(PRICE_TABLE).Value
-                With .Font
-                    .Size = 8
-                    .Bold = True
-                End With
-            End With
-            .HasLegend = True
-            With .Legend
-                .Position = xlTop
-                With .Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            .HasDataTable = False
-            With .Axes(xlCategory)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                .TickLabels.Orientation = xlUpward
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .CrossesAt = 1
-                .TickLabelSpacing = 1
-                .TickMarkSpacing = 1
-                .AxisBetweenCategories = False
-                .ReversePlotOrder = False
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 8
-                End With
-            End With
-            With .Axes(xlValue)
-                .HasMajorGridlines = True
-                .HasMinorGridlines = False
-                With .MajorGridlines.Border
-                    .ColorIndex = 48
-                    .Weight = xlHairline
-                    .LineStyle = xlDot
-                End With
-                .MinimumScale = MinYScale
-                .MaximumScaleIsAuto = True
-                .MinorUnitIsAuto = True
-                .MajorUnitIsAuto = True
-                .Crosses = xlCustom
-                .CrossesAt = MinYScale
-                .ReversePlotOrder = False
-                .ScaleType = xlLinear
-                .TickLabels.AutoScaleFont = True
-                With .TickLabels.Font
-                    .Name = "Arial"
-                    .Size = 9
-                End With
-            End With
-            .ChartTitle.Top = 5
-            .ChartTitle.Left = 5
-            With .Legend
-                .Top = 5
-                .Fill.OneColorGradient _
-                    Style:=msoGradientHorizontal, _
-                    Variant:=3, _
-                    Degree:=0.303913939116503
-                .Fill.Visible = True
-                .Fill.ForeColor.SchemeColor = 71
-            End With
-            .PlotArea.Left = 10
-            .PlotArea.Top = .Legend.Top + .Legend.Height + 5
-            .PlotArea.Width = .ChartArea.Width - 20
-            .PlotArea.Height = .ChartArea.Height - .PlotArea.Top
-            
-' Tune OPEN line
-            With .SeriesCollection(1)
-                .Border.LineStyle = xlNone
-                .MarkerBackgroundColorIndex = xlNone
-                .MarkerForegroundColorIndex = 1
-                .MarkerStyle = xlPlus
-                .Smooth = False
-                .MarkerSize = 9
-                .Shadow = False
-            End With
-' Tune CLOSE line
-            With .SeriesCollection(2)
-                .Border.ColorIndex = 10
-                .Border.Weight = xlMedium
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune RESISTANCE line
-            With .SeriesCollection(3)
-                .Border.ColorIndex = 3
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-' Tune SUUPORT line
-            With .SeriesCollection(4)
-                .Border.ColorIndex = 25
-                .Border.Weight = xlThin
-                .Border.LineStyle = xlContinuous
-            End With
-            If SignalDefined Then
-                With .SeriesCollection(5)
-                    .Border.ColorIndex = 6
-                    .Border.Weight = xlThin
-                    .Border.LineStyle = xlDot
-                End With
-            End If
-        End With
-        .Application.Cursor = xlDefault
-        With .Worksheets(CHART_SHEET)
-            .Select
-            .Protect userInterfaceOnly:=True
-        End With
-    End With
-End Sub
-
-Function GetMinValue(DataRange As Range) As Double
-    Dim Cell As Range
-    Dim MinValue, MaxValue, RangeValue, CorrectValue, Mult As Double
-    MinValue = MAX_PRICE_VALUE
-    MaxValue = MIN_PRICE_VALUE
-    For Each Cell In DataRange
-        If Not IsEmpty(Cell) And IsNumeric(Cell) Then
-            If Cell > MIN_PRICE_VALUE Then
-                If Cell < MinValue Then
-                    MinValue = Cell
-                End If
-                If Cell > MaxValue Then
-                    MaxValue = Cell
-                End If
-            End If
-        End If
-    Next
-    RangeValue = MaxValue - MinValue
-    If RangeValue < 0 Then
-        MinValue = 0
-    Else
-        CorrectValue = RangeValue / 4
-        Mult = MIN_PRICE_VALUE
-        While MinValue - Int(MinValue * Mult) / Mult > CorrectValue
-            Mult = Mult * 10
-        Wend
-        MinValue = Int(MinValue * Mult) / Mult
-    End If
-    GetMinValue = MinValue
-End Function
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{35F0795B-B2D2-4991-B483-85539758086D}{911BB725-D234-48B9-A8AA-300F1C3919E0}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub CommandButton1_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-mWebQeury
->>>>>>
-Attribute VB_Name = "mWebQeury"
-Option Explicit
-
-Public Const Qry_DELETE_ALL As String = "Qry_DELETE_ALL"
-Public Const Qry_PATH_NO_CHANGE As String = "Qry_PATH_NO_CHANGE"
-
-
-Sub QryCreate(QryRange As Range, QryName As String, QryPath As String, Optional RefreshBkgnd = False)
-    Dim WebQuery As QueryTable
-    QryDelete QryRange:=QryRange, QryName:=QryName
-    
-    Set WebQuery = QryRange.Worksheet.QueryTables.Add( _
-            Connection:=QryPath, _
-            Destination:=QryRange)
-    
-    With WebQuery
-        .FieldNames = False
-        .Name = QryName
-        .RefreshStyle = xlOverwriteCells
-        .RowNumbers = False
-        .FillAdjacentFormulas = False
-        .RefreshOnFileOpen = False
-        .HasAutoFormat = False
-        .BackgroundQuery = False
-        .TablesOnlyFromHTML = False
-        .Refresh BackgroundQuery:=RefreshBkgnd
-        .SavePassword = False
-        .SaveData = True
-    End With
-End Sub
-
-Function QryRefresh(QryRange As Range, QryName As String, Optional QryPath As String = Qry_PATH_NO_CHANGE, Optional Background As Boolean = False) As Boolean
-    Dim qry_result As Boolean
-    qry_result = False
-    If QryExist(QryRange, QryName) Then
-        With QryRange.Worksheet.QueryTables(QryName)
-            If QryPath <> Qry_PATH_NO_CHANGE Then
-                .Connection = QryPath
-            End If
-            .Refresh BackgroundQuery:=Background
-            qry_result = True
-        End With
-    End If
-    QryRefresh = qry_result
-End Function
-
-Sub QryDelete(QryRange As Range, Optional QryName As String = Qry_DELETE_ALL)
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If QryName = Qry_DELETE_ALL Or WebQuery.Name = QryName Then
-            WebQuery.Delete
-        End If
-    Next
-End Sub
-
-Function QryExist(QryRange As Range, QryName As String) As Boolean
-    Dim WebQuery As QueryTable
-    For Each WebQuery In QryRange.Worksheet.QueryTables
-        If WebQuery.Name = QryName Then
-            QryExist = True
-            Exit For
-        End If
-    Next
-End Function
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-Attribute CreateCommandBar.VB_ProcData.VB_Invoke_Func = "R\n14"
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Contents"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 49
-                        .OnAction = "cmHelpContents"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible + msoBarNoCustomize + msoBarNoMove + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mTool
->>>>>>
-Attribute VB_Name = "mTool"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub tool_delete_all_tables()
-    QryDelete ThisWorkbook.Worksheets(RAW_DATA_SHEET).Range("A1")
-End Sub
-
-Sub tool_delete_all_charts(theSheet As Worksheet)
-    Dim theChart As Chart
-    For Each theChart In theSheet
-        theChart.Unprotect
-        theChart.Delete
-    Next
-End Sub
-
-Sub DateTimeTest()
-    Dim the_date
-    Dim the_time
-    the_date = DateValue(Now)
-    the_time = TimeValue(Now)
-End Sub
-
-
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{E1DAA7A0-7005-43C9-A7ED-E642DEA5A0CD}{20C12630-E9D0-4B92-9764-77ACD7C8A4FB}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = True
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-
-
-Private Sub App_WorkbookOpen(ByVal wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.count > 1 Then
-        wbname = wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-mDataCommands
->>>>>>
-Attribute VB_Name = "mDataCommands"
-Option Explicit
-
-Sub evFileOpen()
-    Dim fileToOpen As String
-    Dim wb As Workbook
-    Dim Result As Integer
-
-    Set wb = ThisWorkbook
-    With wb
-        If .Worksheets(VAR_SHEET).Range("DEN_SOURCE") <> "file" Then
-            .Worksheets(VAR_SHEET).Range("IDX_DEN_LIST") = 6
-            evGroupChange
-        End If
-        If .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False Or .Worksheets(VAR_SHEET).Range("BOOL_LOAD_DATA") = True Then
-                fileToOpen = .Application.GetOpenFilename( _
-                                  "Text Files (*.txt), *.txt, Data Files (*.csv), *.csv")
-        End If
-          
-        If fileToOpen <> "False" Then
-            .Worksheets(FORM_SHEET).Range(FILE_NAME) = fileToOpen
-            Result = UpdateHistoryFromFile(wb, fileToOpen)
-            .Worksheets(VAR_SHEET).Range("LAST_FILE_QRY") = fileToOpen
-            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-            .Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-            
-            ClearResultTables
-        
-            Select Case Result
-            Case FUNCRES_FILE_OK
-                sbCalcFile
-            Case FUNCRES_FILE_VERY_SMALL
-                .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_VERY_SMALL
-                MsgBox MSG_FILE_VERY_SMALL, vbOKOnly, PROGRAM_NAME
-            Case FUNCRES_FILE_INVALID_FORMAT
-                .Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = MSG_FILE_INVALID_FORMAT
-                MsgBox MSG_FILE_INVALID_FORMAT, vbOKOnly, PROGRAM_NAME
-            End Select
-'            .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False
-        End If
-    End With 'wb
-End Sub
-
-Sub sbCalcFile()
-    Dim wb As Workbook
-    Dim ticker As String
-    
-    Set wb = ThisWorkbook
-    With wb
-        ClearResultTables
-        
-        .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = True
-        If TDenmark_Calc Then
-            ticker = .Worksheets(RAW_DATA_SHEET).Range("B1")
-            Worksheets(FORM_SHEET).Range("CALC_TICKER_NAME") = ticker
-        End If
-    End With 'wb
-End Sub
-
-Sub sbCalcWeb()
-    Dim wb As Workbook
-    Dim ticker As String
-    Dim Period As String
-    
-    Set wb = ThisWorkbook
-    With wb
-        ticker = .Worksheets(VAR_SHEET).Range("DEN_SYMBOL")
-        Period = .Worksheets(VAR_SHEET).Range("DEN_TIME")
-        If .Worksheets(VAR_SHEET).Range("BOOL_DATA_READY") = False Then
-            MsgBox _
-                Prompt:="������������ ������� ������� ������." _
-                    & vbCrLf & "�������� ��������� ������� � �������� �����.", _
-                Buttons:=vbOKOnly + vbExclamation, _
-                Title:=PROGRAM_NAME
-            
-            ClearResultTables
-            
-            With .Worksheets(FORM_SHEET)
-                .Range("CALC_TICKER_NAME") = ticker & ", Period=" & Period
-                .Range("FILE_NAME") = ""
-                .Range(TABLE_COMMENT).Value = "������������ ������"
-            End With
-        Else
-            If TDenmark_Calc Then
-                With .Worksheets(FORM_SHEET)
-                    .Range("CALC_TICKER_NAME") = ticker & ", Period=" & Period
-                    .Range("FILE_NAME") = ""
-                End With
-            End If
-        End If
-    End With
-End Sub
-
-
-Sub evSubmit_Click()
-
-    Application.Cursor = xlWait
-    Dim wb As Workbook
-    Set wb = ThisWorkbook
-    With wb
-        With .Worksheets(VAR_SHEET)
-            If .Range("BOOL_DATA_READY") = False Or .Range("BOOL_LOAD_DATA") = True Then
-                If .Range("BOOL_FILE_DATA") = False Then
-                    .Range("BOOL_DATA_READY") = UpdateHistoryFromWeb(wb)
-                Else
-                    evFileOpen
-                    Application.Cursor = xlDefault
-                    Exit Sub
-                End If
-            End If
-            .Range("BOOL_DEMARK_READY") = False
-            If .Range("BOOL_FILE_DATA") = False Then
-                sbCalcWeb
-            Else
-                sbCalcFile
-            End If
-        End With
-    End With
-    Application.Cursor = xlDefault
-End Sub
-
-Sub evTicker_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SECNAME") = .Range("IDX_DEN_SYMBOL")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evSecName_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("IDX_DEN_SYMBOL") = .Range("IDX_DEN_SECNAME")
-    End With
-    evHistory_Change
-End Sub
-
-Sub evLastInterval_Change()
-    MsgBox "�� �������� � ���� ������"
-End Sub
-
-Sub evHistory_Change()
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        .Range("BOOL_DATA_READY") = False
-    End With
-End Sub
-
-Sub evGroupChange()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange As String
-    With ThisWorkbook.Worksheets(VAR_SHEET)
-        GroupIdx = .Range("IDX_DEN_LIST")
-        .Range("IDX_DEN_SYMBOL") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxTikers").ControlFormat.ListFillRange = NewCbxRange
-        NewRangeOffsetCol = NewRangeOffsetCol + 1
-        NewCbxRange = .Name & "!" & .Range(.Range("TICKER_TABLES").Offset(1, NewRangeOffsetCol), .Range("TICKER_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        ThisWorkbook.Worksheets(FORM_SHEET).Shapes("cbxSecName").ControlFormat.ListFillRange = NewCbxRange
-    End With
-    evTicker_Change
-End Sub
-
-Sub evUpdateTickerList()
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_FILE_DATA") = False Then
-        UpdateTickerList ThisWorkbook
-        evHistory_Change
-    End If
-End Sub
-
-Sub evParamChange()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DEMARK_READY") = False
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_AUTORECALC") = True Then
-        evSubmit_Click
-    End If
-End Sub
-
-<<<<<<
-======================
-mGetFileData
->>>>>>
-Attribute VB_Name = "mGetFileData"
-Option Explicit
-
-Dim mobjAppRunEnable As New cEnableRun
-
-Public Const MAX_LOAD_DATA_LINES As Integer = 16000
-
-Public Const MSG_FILE_VERY_SMALL As String = "� ����� ������������ ������"
-Public Const MSG_FILE_INVALID_FORMAT As String = "�������� ������ �����"
-
-Public Const FUNCRES_FILE_OK As Integer = 0
-Public Const FUNCRES_FILE_VERY_SMALL As Integer = -1
-Public Const FUNCRES_FILE_INVALID_FORMAT As Integer = -2
-
-Function UpdateHistoryFromFile(wb As Workbook, fileToOpen As String) As Integer
-    Dim DestRangeName As String
-    Dim ResultLength As Integer
-    Dim Location As Range
-    Dim denWindow As Integer
-    Dim IsIntraday As Boolean
-    Dim CalcNextTime As Boolean
-        
-    Dim SingleFileLine As String
-    Dim FileHandler As Integer
-    Dim i, j, row_idx As Integer
-    
-    UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-    With wb
-        .Application.ScreenUpdating = False
-        With .Worksheets(VAR_SHEET)
-            CalcNextTime = .Range("BOOL_NEXT_TIME")
-            denWindow = .Range("DEN_WINDOW") + 1
-            If CalcNextTime Then
-                denWindow = denWindow + 1
-            End If
-            IsIntraday = True
-        End With
-        With .Worksheets(RAW_DATA_SHEET)
-            'Clear table include temp area
-            .Parent.Application.DisplayAlerts = False
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW - 1, RAW_DATA_RANGE_COL - 1), _
-                .Cells(65535, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-            ).ClearContents
-            Set Location = .Range(RAW_DATA_RANGE).Offset(-1, 0)
-            
-            ' Reading data from file
-            FileHandler = FreeFile
-            row_idx = 0
-            Open fileToOpen For Input As #FileHandler
-            Do While Not EOF(FileHandler) And row_idx < MAX_LOAD_DATA_LINES
-                Line Input #FileHandler, SingleFileLine
-                .Range(PRICE_TABLE).Offset(row_idx, 0) = SingleFileLine
-                row_idx = row_idx + 1
-            Loop
-            Close #FileHandler
-            
-            ' Parsing data
-            DestRangeName = "=" & RAW_DATA_SHEET & "!$B$1:$B" & row_idx
-            ResultLength = row_idx
-            
-            .Range(DestRangeName).TextToColumns _
-                Destination:=.Range(DestRangeName), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=True, _
-                Semicolon:=True, _
-                Comma:=True, _
-                Space:=False, _
-                Other:=False, _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), _
-                                Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
-            
-            .Parent.Application.DisplayAlerts = True
-            Dim CurrentDate As String
-            Dim RawData As Range
-            
-            Set RawData = .Range(RAW_DATA_RANGE)
-            
-            If Not CheckFileFormat(RawData.Offset(-1, 0)) Then
-                UpdateHistoryFromFile = FUNCRES_FILE_INVALID_FORMAT
-                Exit Function
-            End If
-            
-            row_idx = 0
-            With RawData
-                CurrentDate = .Value
-                For i = 1 To ResultLength
-                    If Not IsIntraday And CurrentDate = .Offset(i, DATE_IDX).Value Then
-                        ' skip virtual prices
-                        If (.Offset(i, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            If .Offset(row_idx, HIGH_IDX).Value < .Offset(i, HIGH_IDX).Value Then
-                                .Offset(row_idx, HIGH_IDX).Value = .Offset(i, HIGH_IDX).Value
-                            End If
-                            If .Offset(row_idx, LOW_IDX).Value > .Offset(i, LOW_IDX).Value Then
-                                .Offset(row_idx, LOW_IDX).Value = .Offset(i, LOW_IDX).Value
-                            End If
-                            .Offset(row_idx, VOLUME_IDX).Value = _
-                                .Offset(row_idx, VOLUME_IDX).Value + .Offset(i, VOLUME_IDX).Value
-                            .Offset(row_idx, TIME_IDX).Value = .Offset(i, TIME_IDX).Value
-                            .Offset(row_idx, CLOSE_IDX).Value = .Offset(i, CLOSE_IDX).Value
-                        End If
-                    Else
-                        ' skip virtual prices
-                        If (.Offset(row_idx, VOLUME_IDX) > MIN_PRICE_VALUE) Then
-                            row_idx = row_idx + 1
-                        End If
-                        For j = DATE_IDX To VOLUME_IDX
-                            .Offset(row_idx, j) = .Offset(i, j)
-                        Next j
-                        CurrentDate = .Offset(i, DATE_IDX)
-                    End If
-                Next i
-            End With ' RawData
-            ' Clear unused Cells
-            .Range( _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(65536, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-            ).ClearContents
-            
-            If row_idx > denWindow Then
-                row_idx = row_idx - denWindow
-                .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + PROJECT_IDX) _
-                ).Delete xlShiftUp
-            Else
-                UpdateHistoryFromFile = FUNCRES_FILE_VERY_SMALL
-                Exit Function
-            End If
-            
-            row_idx = denWindow + 1
-            
-            Set Location = .Range( _
-                .Cells(RAW_DATA_RANGE_ROW, RAW_DATA_RANGE_COL + DATE_IDX), _
-                .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_IDX) _
-            )
-            
-            Location.TextToColumns _
-                Destination:=Location.Offset(0, DATE_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:="/", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
-            
-            Location.Offset(0, TIME_IDX).TextToColumns _
-                Destination:=Location.Offset(0, TIME_STAMP_OFFSET), _
-                DataType:=xlDelimited, _
-                TextQualifier:=xlDoubleQuote, _
-                ConsecutiveDelimiter:=False, _
-                Tab:=False, _
-                Semicolon:=False, _
-                Comma:=False, _
-                Space:=False, _
-                Other:=True, _
-                OtherChar:=":", _
-                FieldInfo:=Array(Array(1, 2), Array(2, 2))
-            
-            ' Check estimation date
-            
-            Dim end_date, end_time As Date
-            Dim year, month, day As Integer
-            Dim hour, minute As Integer
-            Dim next_time_exist As Boolean
-            
-            year = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 3)
-            month = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 2)
-            day = Location.Cells(denWindow - 1, DATE_STAMP_OFFSET + 1)
-            hour = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 1)
-            minute = Location.Cells(denWindow - 1, TIME_STAMP_OFFSET + 2)
-            
-            next_time_exist = day + month + year <> 0
-            
-            If next_time_exist Then
-                end_date = DateSerial(year, month, day)
-                end_time = TimeSerial(hour, minute, 0)
-                mobjAppRunEnable.EnableRun ESTIMATION_DATE, end_date
-            End If
-             
-            row_idx = 0
-            Dim temp_str As String
-                    
-            If IsIntraday Then
-                Do While IsEmpty(Location.Cells(1 + row_idx, 1 + DATE_IDX)) = False
-                       temp_str = Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 1)
-                       temp_str = temp_str & "/"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + PROJECT_IDX + 2)
-                       temp_str = temp_str & "-"
-                       temp_str = temp_str & Location.Cells(1 + row_idx, 1 + TIME_IDX)
-                       Location.Cells(1 + row_idx, DATE_IDX) = temp_str
-                       row_idx = row_idx + 1
-                Loop
-                row_idx = row_idx - 1
-                Dim condition As Boolean
-                condition = Not CalcNextTime And next_time_exist And end_date = DateValue(Now) And end_time > TimeValue(Now)
-                If condition Then
-                    .Range( _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL - 1), _
-                        .Cells(RAW_DATA_RANGE_ROW + row_idx, RAW_DATA_RANGE_COL + DATE_STAMP_OFFSET + DATE_TIME_STAMP_SIZE) _
-                    ).Delete xlShiftUp
-                End If
-            End If
-        End With ' .Worksheets(RAW_DATA_SHEET)
-    End With ' wb
-    UpdateHistoryFromFile = FUNCRES_FILE_OK
-End Function
-
-Function CheckFileFormat(HeaderString As Range) As Boolean
-    With HeaderString
-        CheckFileFormat = _
-            .Offset(0, DATE_IDX) = "Date" And _
-            .Offset(0, TIME_IDX) = "Time" And _
-            .Offset(0, OPEN_IDX) = "Open" And _
-            .Offset(0, CLOSE_IDX) = "Close" And _
-            .Offset(0, LOW_IDX) = "Low" And _
-            .Offset(0, HIGH_IDX) = "High" And _
-            .Offset(0, VOLUME_IDX) = "Volume"
-    End With
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Macros
->>>>>>
-Attribute VB_Name = "Macros"
-Sub RangeNorm()
-    Dim src As Range
-    Dim dst As Range
-    
-    Set dst = Selection
-    Selection.DirectPrecedents.Select
-    Set src = Selection
-    RangeNormalize src, dst
-End Sub
-
-Sub RangeNormalize(src As Range, dst As Range)
-    Dim f As Double
-    Dim c As Range
-    f = dst
-    If f <> 0 Then
-        For Each c In src
-            c = c / f
-        Next c
-    End If
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Unprotect "password"
-    ThisWorkbook.Save
-End Sub
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Protect password:="password"
-    Worksheets("Calc").Protect password:="password", userInterfaceonly:=True
-    Worksheets("Calc").Select
-    Worksheets("Calc").Range("A7").Select
-End Sub
-<<<<<<
-======================
-Calc
->>>>>>
-Attribute VB_Name = "Calc"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Sub SelectAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOn
-        End If
-    Next Sh
-    Range("A7").Select
-End Sub
-
-Sub ClearAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOff
-        End If
-    Next Sh
-    Range("A7").Select
-    Worksheets("Data").Range("K2") = 1
-    Worksheets("Calc").Range("E58") = 1
-End Sub
-
-<<<<<<
-======================
-Data
->>>>>>
-Attribute VB_Name = "Data"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Unprotect "password"
-    ThisWorkbook.Save
-End Sub
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Protect password:="password"
-    Worksheets("Calc").Protect password:="password", userInterfaceonly:=True
-    Worksheets("Calc").Select
-    Worksheets("Calc").Range("A7").Select
-End Sub
-<<<<<<
-======================
-Calc
->>>>>>
-Attribute VB_Name = "Calc"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Sub SelectAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOn
-        End If
-    Next Sh
-    Range("A7").Select
-End Sub
-
-Sub ClearAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOff
-        End If
-    Next Sh
-    Range("A7").Select
-    Worksheets("Data").Range("K2") = 1
-    Worksheets("Calc").Range("E58") = 1
-End Sub
-
-<<<<<<
-======================
-Data
->>>>>>
-Attribute VB_Name = "Data"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Unprotect "password"
-    ThisWorkbook.Save
-End Sub
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Protect password:="password"
-    Worksheets("Calc").Protect password:="password", userInterfaceonly:=True
-    Worksheets("Calc").Select
-    Worksheets("Calc").Range("A7").Select
-End Sub
-<<<<<<
-======================
-Calc
->>>>>>
-Attribute VB_Name = "Calc"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Sub SelectAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOn
-        End If
-    Next Sh
-    Range("A7").Select
-End Sub
-
-Sub ClearAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOff
-        End If
-    Next Sh
-    Range("A7").Select
-    Worksheets("Data").Range("K2") = 1
-    Worksheets("Calc").Range("E58") = 1
-End Sub
-
-<<<<<<
-======================
-Data
->>>>>>
-Attribute VB_Name = "Data"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Dec2TS
->>>>>>
-Attribute VB_Name = "Dec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-Dec2Hex
->>>>>>
-Attribute VB_Name = "Dec2Hex"
-Option Explicit
-
-
-Function Dec2Hex(Dec As Long) As String
-
-Const HexNumbers As String = "0123456789ABCDEF"
-Const HexBase As Integer = 16
-    
-    Dim HexStr As String
-    Dim idx As Integer
-    
-    HexStr = ""
-    
-    If Dec = 0 Then
-        HexStr = Mid(HexNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod HexBase
-            HexStr = Mid(HexNumbers, idx + 1, 1) + HexStr
-            Dec = Dec \ HexBase
-        Wend
-    End If
-    Dec2Hex = HexStr
-End Function
-
-
-Function Dec2Thirty(Dec As Long) As String
-
-Const ThirtyNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRST"
-Const ThirtyBase As Integer = 30
-    
-    Dim ThirtyStr As String
-    Dim idx As Integer
-    
-    ThirtyStr = ""
-    
-    If Dec = 0 Then
-        ThirtyStr = Mid(ThirtyNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtyBase
-            ThirtyStr = Mid(ThirtyNumbers, idx + 1, 1) + ThirtyStr
-            Dec = Dec \ ThirtyBase
-        Wend
-    End If
-    Dec2Thirty = ThirtyStr
-End Function
-
-<<<<<<
-======================
-Serial
->>>>>>
-Attribute VB_Name = "Serial"
-Option Explicit
-
-Function LeadingNull(FmtStr As String, Dec As Integer) As String
-    Dim s As String
-        
-    LeadingNull = s
-End Function
-
-Function HowDigits(Dec As Integer) As Integer
-    Dim n As Integer
-    n = 0
-    While Dec <> 0
-         Dec = Dec \ 10
-         n = n + 1
-    Wend
-    HowDigits = n
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Macros
->>>>>>
-Attribute VB_Name = "Macros"
-Sub RangeNorm()
-    Dim src As Range
-    Dim dst As Range
-    
-    Set dst = Selection
-    Selection.DirectPrecedents.Select
-    Set src = Selection
-    RangeNormalize src, dst
-End Sub
-
-Sub RangeNormalize(src As Range, dst As Range)
-    Dim f As Double
-    Dim c As Range
-    f = dst
-    If f <> 0 Then
-        For Each c In src
-            c = c / f
-        Next c
-    End If
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ClientContact
->>>>>>
-Attribute VB_Name = "ClientContact"
-Attribute VB_Base = "0{D082ACDB-DC01-4BAC-B1F3-E7AB4DF09CA4}{65A5E819-AC4C-46D3-923F-BCD8180C1EB7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-    Dim edit_mode As Boolean
-    edit_mode = Worksheets(SHEET_OEM_DATA).Range("EditAppMode")
-    If edit_mode Then
-        btEditApp_Click
-    End If
-    Worksheets(SHEET_OEM_KEY).Select
-End Sub
-<<<<<<
-======================
-xTEST_NUM
->>>>>>
-Attribute VB_Name = "xTEST_NUM"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-xFACE
->>>>>>
-Attribute VB_Name = "xFACE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    setup_interface
-End Sub
-
-Sub setup_interface()
-    Dim listsize As Integer
-    Dim r As Range
-    Dim NewCbxRange As String
-    Dim NewCbxSelection As String
-    
-    NewCbxRange = Get_OEM_Names_Range_Address
-    NewCbxSelection = Worksheets(SHEET_OEM_DATA).Name & "!" & _
-                        Worksheets(SHEET_OEM_DATA).Range(RANGE_OEM_IDX).Address
-    Unprotect
-    ActiveSheet.Shapes("oemList").Select
-    With Selection
-        .ListFillRange = NewCbxRange
-        .LinkedCell = NewCbxSelection
-        .DropDownLines = 8
-        .Display3DShading = True
-    End With
-    
-    NewCbxRange = Get_SYS_Names_Range_Address
-    NewCbxSelection = Worksheets(SHEET_OEM_DATA).Name & "!" & _
-                        Worksheets(SHEET_OEM_DATA).Range(RANGE_SYS_IDX).Address
-                        
-    Worksheets(SHEET_OEM_KEY).Shapes("sysList").Select
-    With Selection
-        .ListFillRange = NewCbxRange
-        .LinkedCell = NewCbxSelection
-        .DropDownLines = 8
-        .Display3DShading = True
-    End With
-    
-    NewCbxRange = Get_SOFT_Names_Range_Address
-    NewCbxSelection = Worksheets(SHEET_OEM_DATA).Name & "!" & _
-                        Worksheets(SHEET_OEM_DATA).Range(RANGE_SOFT_IDX).Address
-                        
-    Worksheets(SHEET_OEM_KEY).Shapes("softList").Select
-    With Selection
-        .ListFillRange = NewCbxRange
-        .LinkedCell = NewCbxSelection
-        .DropDownLines = 8
-        .Display3DShading = True
-    End With
-    
-    Range("Version").Select
-    If Not Worksheets(SHEET_OEM_DATA).Range("EditAppMode") Then
-        Protect UserInterfaceonly:=True
-    End If
-End Sub
-<<<<<<
-======================
-xTEST_SER
->>>>>>
-Attribute VB_Name = "xTEST_SER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Dec2TS
->>>>>>
-Attribute VB_Name = "Dec2TS"
-Option Explicit
-
-'Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-'Const ThirtySixBase As Integer = 36
-
-Public Const ThirtySixNumbers As String = "123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
-Public Const ThirtySixBase As Integer = 34
-
-Function Dec2ThirtySix(ByVal Dec As Long) As String
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Double
-    
-    ThirtySixStr = TS
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If ThirtySixStr = "" Then
-        Dec = 0
-    Else
-        While ThirtySixStr <> ""
-            lastdigit = Right(ThirtySixStr, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            ThirtySixStr = Mid(ThirtySixStr, 1, Len(ThirtySixStr) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-
-Function ThirtySix2ChkSum(TS As String) As Integer
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim chksum As Integer
-    
-    ThirtySixStr = TS
-
-    chksum = 0
-    
-    If ThirtySixStr = "" Then
-        chksum = 0
-    Else
-        While ThirtySixStr <> ""
-            lastdigit = Right(ThirtySixStr, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit) - 1
-            chksum = (chksum + idx) Mod ThirtySixBase
-            ThirtySixStr = Left(ThirtySixStr, Len(ThirtySixStr) - 1)
-        Wend
-    End If
-
-    ThirtySix2ChkSum = chksum
-End Function
-<<<<<<
-======================
-newItemDlg
->>>>>>
-Attribute VB_Name = "newItemDlg"
-Attribute VB_Base = "0{C677F1A4-9481-4111-8411-6942E8A48078}{F44556AE-89CF-426B-B97B-86777B210E93}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub AddSYS_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub resetSYS_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-<<<<<<
-======================
-xTEST_SN
->>>>>>
-Attribute VB_Name = "xTEST_SN"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-xDATA
->>>>>>
-Attribute VB_Name = "xDATA"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mSerial
->>>>>>
-Attribute VB_Name = "mSerial"
-Option Explicit
-
-Public Const SN_MAX_ROOT As Integer = ThirtySixBase - 1
-Public Const SN_MAX_NUM2 As Integer = ThirtySixBase ^ 2
-Public Const SN_MAX_NUM4 As Long = ThirtySixBase ^ 3
-Public Const SN_MAX_PREFIX_NOISE As Integer = (ThirtySixBase ^ 2) \ 2
-Public Const SN_MAX_SERIA As Long = 50000
-Public Const SN_MAX_VERSION As Long = 999
-
-Public Const SN_MIN_OEM_ID As Integer = 100
-Public Const SN_MIN_SYS_ID As Integer = 100
-Public Const SN_MIN_SOFT_ID As Integer = 100
-
-Public Const SN_MAX_OEM_ID As Integer = 300
-Public Const SN_MAX_SYS_ID As Integer = 300
-Public Const SN_MAX_SOFT_ID As Integer = 300
-
-Public Const SN_TOP_SERIA As Long = 100000
-Public Const SN_TOP_VER As Long = 1000
-Public Const SN_LEN_T As Integer = 25
-Public Const SN_LEN_1 As Integer = 5
-Public Const SN_LEN_2 As Integer = 5
-Public Const SN_LEN_3 As Integer = 6
-Public Const SN_LEN_4 As Integer = 5
-
-Function serial_check_id_sum(id_sn As String) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim chk As Integer
-    
-    s = id_sn
-    chk = 0
-    While s <> ""
-        i = Left(s, 1)
-        chk = (chk + i) Mod 10
-        s = Right(s, Len(s) - 1)
-    Wend
-    serial_check_id_sum = chk
-End Function
-
-Function get_sn_root(sn As String) As Integer
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_root = 0
-        Exit Function
-    End If
-    
-    Dim s As String
-    s = Right(sn, 1)
-    get_sn_root = ThirtySix2Dec(s)
-End Function
-
-Function serial_check_id(sn As String) As Boolean
-    Dim chk_id As Integer
-    Dim s As String
-    
-    chk_id = get_sn_check_id(sn)
-    s = get_sn_1(sn)
-    s = s & get_sn_2(sn)
-    s = s & Left(get_sn_3(sn), Len("" & SN_TOP_SERIA))
-    s = s & Right(get_sn_3(sn), 3) & get_sn_4(sn)
-    Dim ci As Integer
-    ci = serial_check_id_sum(s)
-    serial_check_id = ci = chk_id
-End Function
-
-Function serial_check(sn As String) As Boolean
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        serial_check = False
-        Exit Function
-    End If
-    
-    Dim chk As Integer
-    chk = ThirtySix2Dec(Left(sn, 1))
-    
-    Dim bool As Boolean
-    bool = Len(sn) = SN_LEN_T
-    bool = bool And ThirtySix2ChkSum(get_sn_noise(sn)) = chk
-    bool = bool And serial_check_id(sn)
-
-    serial_check = bool
-End Function
-
-Function get_sn_noise(sn As String) As String
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_noise = ""
-        Exit Function
-    End If
-        
-    Dim root As Integer
-    Dim s As String
-    root = get_sn_root(sn)
-    s = Mid(sn, 2, Len(sn) - 2)
-    get_sn_noise = ROT_Right(s, root)
-End Function
-
-Function get_sn_clear(sn As String) As String
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_clear = ""
-        Exit Function
-    End If
-        
-    Dim s As String
-    s = get_sn_noise(sn)
-    get_sn_clear = Right(s, Len(s) - 2)
-End Function
-
-Function get_sn_1(sn As String) As String
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_1 = ""
-        Exit Function
-    End If
-        
-    get_sn_1 = "" & ThirtySix2Dec(Left(get_sn_clear(sn), SN_LEN_1))
-End Function
-
-Function get_sn_oem_id(sn As String) As Integer
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_oem_id = -1
-        Exit Function
-    End If
-    
-    get_sn_oem_id = Right(get_sn_1(sn), 3)
-End Function
-
-Function get_sn_oem_name(sn As String) As String
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_oem_name = ""
-        Exit Function
-    End If
-    
-    Dim oem_id As Integer
-    Dim r As Range
-    Dim c As Range
-    Dim s As String
-    oem_id = get_sn_oem_id(sn)
-    s = Get_OEM_ID_Range_Address
-    Set r = Range(s)
-    s = ""
-    For Each c In r
-        If c = oem_id Then
-            s = c.Offset(0, 1)
-            Exit For
-        End If
-    Next c
-    get_sn_oem_name = s
-End Function
-
-Function get_sn_date(sn As String) As Long
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_date = -1
-        Exit Function
-    End If
-    
-    Dim s1 As String
-    s1 = get_sn_1(sn)
-    get_sn_date = Left(s1, 5)
-End Function
-
-Function get_sn_2(sn As String) As String
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_2 = ""
-        Exit Function
-    End If
-    get_sn_2 = "" & ThirtySix2Dec(Mid(get_sn_clear(sn), SN_LEN_1 + 1, SN_LEN_2))
-End Function
-
-Function get_sn_version(sn As String) As Integer
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_version = -1
-        Exit Function
-    End If
-    get_sn_version = Right(get_sn_2(sn), 4) - SN_TOP_VER
-End Function
-
-Function get_sn_3(sn As String) As String
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_3 = ""
-        Exit Function
-    End If
-    get_sn_3 = "" & ThirtySix2Dec(Mid(get_sn_clear(sn), _
-                                        SN_LEN_1 + SN_LEN_2 + 1, _
-                                        SN_LEN_3) _
-                                    )
-End Function
-
-Function get_sn_soft_id(sn As String) As Integer
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_soft_id = -1
-        Exit Function
-    End If
-    get_sn_soft_id = Right(get_sn_3(sn), 3)
-End Function
-
-Function get_sn_check_id(sn As String) As Integer
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_check_id = 0
-        Exit Function
-    End If
-    get_sn_check_id = Mid(get_sn_3(sn), 7, 1)
-End Function
-
-Function get_sn_soft_name(sn As String) As String
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_soft_name = ""
-        Exit Function
-    End If
-    
-    Dim soft_id As Integer
-    Dim r As Range
-    Dim c As Range
-    Dim s As String
-    soft_id = get_sn_soft_id(sn)
-    s = Get_SOFT_ID_Range_Address
-    Set r = Range(s)
-    s = ""
-    For Each c In r
-        If c = soft_id Then
-            s = c.Offset(0, 1)
-            Exit For
-        End If
-    Next c
-    get_sn_soft_name = s
-End Function
-
-Function get_sn_seria(sn As String) As Long
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_seria = -1
-        Exit Function
-    End If
-    
-    Dim s3 As String
-    s3 = get_sn_3(sn)
-    get_sn_seria = Left(s3, 6) - SN_TOP_SERIA + 1
-End Function
-
-Function get_sn_4(sn As String) As String
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_4 = ""
-        Exit Function
-    End If
-    
-    get_sn_4 = "" & ThirtySix2Dec(Mid(get_sn_clear(sn), _
-                                        SN_LEN_1 + SN_LEN_2 + SN_LEN_3 + 1, _
-                                        SN_LEN_4) _
-                                    )
-End Function
-
-Function get_sn_sys_id(sn As String) As Integer
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_sys_id = -1
-        Exit Function
-    End If
-    
-    get_sn_sys_id = Left(get_sn_4(sn), 3)
-End Function
-
-Function get_sn_sys_name(sn As String) As String
-    If sn = "" Or Len(sn) < SN_LEN_T Then
-        get_sn_sys_name = ""
-        Exit Function
-    End If
-    
-    Dim sys_id As Integer
-    Dim r As Range
-    Dim c As Range
-    Dim s As String
-    sys_id = get_sn_sys_id(sn)
-    s = Get_SYS_ID_Range_Address
-    Set r = Range(s)
-    s = ""
-    
-    For Each c In r
-        If c = sys_id Then
-            s = c.Offset(0, 1)
-            Exit For
-        End If
-    Next c
-    get_sn_sys_name = s
-End Function
-
-Function set_sn_root() As Long
-    set_sn_root = Int(Rnd() * SN_MAX_ROOT) + 1
-End Function
-
-Function set_sn_num2() As Long
-    set_sn_num2 = SN_MAX_NUM2 + Int(Rnd() * (SN_MAX_NUM2))
-End Function
-
-Function set_sn_num4() As Long
-    set_sn_num4 = SN_MAX_NUM4 + Int(Rnd() * (SN_MAX_NUM4))
-End Function
-
-Function set_prefix_noise() As Long
-    set_prefix_noise = SN_MAX_PREFIX_NOISE + _
-                        Int(Rnd() * (SN_MAX_PREFIX_NOISE - 1)) + 1
-End Function
-
-Function set_sn_date() As Long
-    Dim d_date As Long
-    d_date = (Year(Now()) Mod 10)
-    d_date = d_date * 10000
-    d_date = d_date + Month(Now()) * 100
-    d_date = d_date + Day(Now())
-    set_sn_date = d_date
-End Function
-
-Function set_sn_1(oem_id As Integer) As String
-    set_sn_1 = set_sn_date & oem_id
-End Function
-
-Function set_sn_2(ByVal version As Integer) As String
-    version = version + SN_TOP_VER
-    set_sn_2 = set_sn_num2 & version
-End Function
-
-Function set_sn_3(soft_id As Integer, seria As Long, cs As String) As String
-    set_sn_3 = (seria - 1 + SN_TOP_SERIA) & cs & soft_id
-End Function
-
-Function set_sn_4(sys_id As Integer) As String
-    set_sn_4 = sys_id & set_sn_num4
-End Function
-
-Function serial_generate(oem_id As Integer, soft_id As Integer, ver As Integer, sys_id As Integer, seria As Long)
-    Dim sn As String
-    Dim chk As String
-    Dim root As Integer
-    Dim s1 As String
-    Dim s2 As String
-    Dim s4 As String
-    
-    s1 = set_sn_1(oem_id)
-    s2 = set_sn_2(ver)
-    s4 = set_sn_4(sys_id)
-    
-    sn = s1 & s2 & set_sn_3(soft_id, seria, "") & s4
-    
-    chk = serial_check_id_sum(sn)
-     
-    sn = Dec2ThirtySix(set_prefix_noise) & _
-            Dec2ThirtySix(s1) & _
-            Dec2ThirtySix(s2) & _
-            Dec2ThirtySix(set_sn_3(soft_id, seria, chk)) & _
-            Dec2ThirtySix(s4)
-    
-    chk = Dec2ThirtySix(ThirtySix2ChkSum(sn))
-    root = set_sn_root
-    sn = chk & ROT_Left(sn, root) & Dec2ThirtySix(root)
-
-    serial_generate = sn
-End Function
-
-Function serial_format(sn As String, deliver As String) As String
-    serial_format = Left(sn, 5) _
-            & deliver & Mid(sn, 6, 5) _
-            & deliver & Mid(sn, 11, 5) _
-            & deliver & Mid(sn, 16, 5) _
-            & deliver & Right(sn, Len(sn) - 20)
-End Function
-
-Function Rotate_Left(r As Range, position As Integer) As String
-    Dim r_str As String
-    r_str = r
-    Rotate_Left = ROT_Left(r_str, position)
-End Function
-
-Function Rotate_Right(r As Range, position As Integer) As String
-    Dim r_str As String
-    r_str = r
-    Rotate_Right = ROT_Right(r_str, position)
-End Function
-
-Function ROT_Left(s As String, position As Integer) As String
-    Dim i As Integer
-    Dim slen As Integer
-    
-    Dim r_str As String
-    Dim ch As String
-    
-    r_str = s
-    
-    slen = Len(r_str)
-    For i = 1 To position
-        ch = Left(r_str, 1)
-        r_str = Right(r_str, slen - 1)
-        r_str = r_str + ch
-    Next i
-    
-    ROT_Left = r_str
-End Function
-
-Function ROT_Right(s As String, position As Integer) As String
-    Dim i As Integer
-    Dim slen As Integer
-    
-    Dim r_str As String
-    Dim ch As String
-    
-    r_str = s
-    
-    slen = Len(r_str)
-    For i = 1 To position
-        ch = Right(r_str, 1)
-        r_str = Left(r_str, slen - 1)
-        r_str = ch + r_str
-    Next i
-    
-    ROT_Right = r_str
-End Function
-
-<<<<<<
-======================
-mInterface
->>>>>>
-Attribute VB_Name = "mInterface"
-Option Explicit
-
-Public Const SHEET_OEM_DATA As String = "xDATA"
-Public Const SHEET_OEM_KEY As String = "zFACE"
-
-Public Const RANGE_OEM_IDX As String = "OEM_IDX"
-Public Const RANGE_OEM_ID As String = "OEM_ID"
-Public Const RANGE_OEM_NAME As String = "OEM_NAME"
-
-Public Const RANGE_SYS_IDX As String = "SYS_IDX"
-Public Const RANGE_SYS_ID As String = "SYS_ID"
-Public Const RANGE_SYS_NAME As String = "SYS_NAME"
-
-Public Const RANGE_SOFT_IDX As String = "SOFT_IDX"
-Public Const RANGE_SOFT_ID As String = "SOFT_ID"
-Public Const RANGE_SOFT_NAME As String = "SOFT_NAME"
-
-Const ITEM_ADDED As String = " added to DB :)"
-Const ITEM_IGNORED As String = " nothing :("
-
-Sub btEditApp_Click()
-    Dim mode As Range
-    Set mode = Worksheets(SHEET_OEM_DATA).Range("EditAppMode")
-    mode.Worksheet.Unprotect
-    If mode = True Then
-        mode = False
-    Else
-        mode = True
-    End If
-    With Worksheets(SHEET_OEM_KEY)
-        .Select
-        .Unprotect
-        .Shapes("btEditApp").Select
-        With Selection
-            If mode Then
-                .Characters.Text = "Run"
-                show_sheets
-            Else
-                .Characters.Text = "EditApp"
-                hide_sheets
-            End If
-        End With
-        .Range("Version").Select
-        If Not mode Then
-            .Protect UserInterfaceonly:=True
-        End If
-    End With
-End Sub
-
-Sub snClear_Click()
-    Worksheets(SHEET_OEM_KEY).Range("C15,E15,G15,I15,K15").ClearContents
-End Sub
-
-Sub snCreate_Click()
-    Dim d_date As Long
-    Dim seria As Long
-    Dim version As Integer
-    Dim oem_id As Integer
-    Dim sys_id As Integer
-    Dim soft_id As Integer
-    Dim oem_name As String
-    Dim sys_name As String
-    Dim soft_name As String
-    Dim i As Long
-    Dim r As Range
-    
-    With Worksheets(SHEET_OEM_KEY)
-        version = .Range("Version")
-        seria = .Range("Seria")
-        
-        If version > SN_MAX_VERSION Or version < 1 Then
-            MsgBox "������ �� ����� ���� ������ 1 � ������ 999"
-            .Range("Version").Select
-            Exit Sub
-        End If
-    
-        If seria > SN_MAX_SERIA Or seria < 1 Then
-            MsgBox "����� �� ����� ���� ������ 1 � ������ 50 000"
-            .Range("Seria").Select
-            Exit Sub
-        End If
-    End With
-    
-    
-    Dim calc_type As Integer
-    calc_type = Application.Calculation
-    Application.Calculation = xlCalculationManual
-    
-    With Worksheets(SHEET_OEM_DATA)
-        oem_id = .Range(RANGE_OEM_IDX)
-        oem_name = .Range(RANGE_OEM_NAME).Offset(oem_id - 1, 0)
-        oem_id = .Range(RANGE_OEM_ID).Offset(oem_id - 1, 0)
-        
-        sys_id = .Range(RANGE_SYS_IDX)
-        sys_name = .Range(RANGE_SYS_NAME).Offset(sys_id - 1, 0)
-        sys_id = .Range(RANGE_SYS_ID).Offset(sys_id - 1, 0)
-        
-        soft_id = .Range(RANGE_SOFT_IDX)
-        soft_name = .Range(RANGE_SOFT_NAME).Offset(soft_id - 1, 0)
-        soft_id = .Range(RANGE_SOFT_ID).Offset(soft_id - 1, 0)
-    End With
-    
-    Dim s As String
-    s = get_new_oem_serial_range
-    Set r = Range(s)
-    
-    r.Worksheet.Unprotect
-    
-    s = Get_OEM_Names_Range_Address
-    r.Offset(0, 0) = oem_id
-    r.Offset(1, 0) = set_sn_date
-    r.Offset(2, 0) = soft_id
-    r.Offset(3, 0) = version
-    r.Offset(4, 0) = sys_name
-    r.Offset(5, 0) = seria
-    
-    Set r = r.Offset(5, 0)
-    
-    Randomize
-    
-    For i = 1 To seria
-        r.Offset(i, 0) = serial_format( _
-                            serial_generate(oem_id, soft_id, version, sys_id, seria), _
-                            " " _
-                        )
-    Next i
-    With r.EntireColumn
-        .AutoFit
-        .HorizontalAlignment = xlCenter
-        .VerticalAlignment = xlBottom
-        .WrapText = False
-    End With
-    r.Worksheet.Select
-    r.Select
-    Application.Calculation = calc_type
-    Application.Calculate
-End Sub
-
-Sub exportSerial()
-    Dim fs As Object
-    Dim a As Object
-    Dim fpath As String
-    Dim fname As String
-    Dim r As Range
-    
-    fpath = GetWBPath(ThisWorkbook.FullName)
-    fname = get_serial_exp_filename()
-    If fname = "" Then
-        MsgBox ("=8-(")
-        Exit Sub
-    End If
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    fname = fpath & fname & ".txt"
-    Set a = fs.CreateTextFile(fname, True)
-    
-    Set r = Range(get_last_oem_serial_range).Offset(5, 0)
-    While r <> ""
-        a.WriteLine (r)
-        Set r = r.Offset(1, 0)
-    Wend
-    a.Close
-    MsgBox ("saved in:" & fname & " ;-)")
-End Sub
-
-Function get_last_oem_serial_range() As String
-    Dim r As Range
-    Set r = Worksheets(get_oem_sheet_name).Range("A1")
-    While r.Offset(0, 1) <> ""
-        Set r = r.Offset(0, 1)
-    Wend
-    get_last_oem_serial_range = r.Worksheet.Name & "!" & r.Address
-End Function
-
-Function get_new_oem_serial_range() As String
-    Dim r As Range
-    Set r = Range(get_last_oem_serial_range)
-    get_new_oem_serial_range = r.Worksheet.Name & "!" & r.Offset(0, 1).Address
-End Function
-
-Function get_serial_exp_filename() As String
-    Dim s As String
-    Dim r As Range
-    s = ""
-    Set r = Range(get_last_oem_serial_range)
-    If r <> ActiveSheet.Range("A1") Then
-        s = r & "_" _
-            & r.Offset(1, 0) & "_" _
-            & r.Offset(2, 0) & "_" _
-            & r.Offset(3, 0) & "_" _
-            & r.Offset(4, 0) & "_" _
-            & r.Offset(5, 0)
-    End If
-    get_serial_exp_filename = s
-End Function
-
-Function get_oem_sheet_name() As String
-    Dim oem_id As Integer
-    With Worksheets(SHEET_OEM_DATA)
-        oem_id = .Range(RANGE_OEM_IDX)
-        oem_id = .Range(RANGE_OEM_ID).Offset(oem_id - 1, 0)
-    End With
-    get_oem_sheet_name = "OEM_" & oem_id
-End Function
-
-Sub to_oem()
-    With Worksheets(get_oem_sheet_name)
-        .Select
-        .Range("A1").Select
-        .Protect UserInterfaceonly:=True
-    End With
-End Sub
-
-Sub to_home()
-    Worksheets(SHEET_OEM_KEY).Select
-End Sub
-
-Sub softAdd_Click()
-    Dim dlg As newItemDlg
-    Set dlg = New newItemDlg
-    
-    dlg.Caption = "Add new Software"
-    dlg.l_ItemName = "Name:"
-    
-    dlg.Show
-
-    Dim msg As String
-    msg = ITEM_IGNORED
-    
-    If dlg.Tag = vbOK Then
-        Dim s As String
-        
-        s = dlg.edItemVal
-        If s <> "" Then
-            AddNewSoft (s)
-            msg = s + ITEM_ADDED
-        End If
-        MsgBox msg
-    End If
-End Sub
-
-Sub oemAdd_Click()
-    Dim dlg As newItemDlg
-    Set dlg = New newItemDlg
-    
-    dlg.Caption = "Add new OEM"
-    dlg.l_ItemName = "Name:"
-    
-    dlg.Show
-    
-    Dim msg As String
-    msg = ITEM_IGNORED
-    
-    If dlg.Tag = vbOK Then
-        Dim s As String
-        
-        s = dlg.edItemVal
-        If s <> "" Then
-            AddNewOEM (s)
-            msg = s + ITEM_ADDED
-        End If
-        MsgBox msg
-    End If
-End Sub
-
-Sub sysAdd_Click()
-    Dim dlg As newItemDlg
-    Set dlg = New newItemDlg
-    
-    dlg.Caption = "Add new System"
-    dlg.l_ItemName = "Name:"
-    
-    dlg.Show
-
-    Dim msg As String
-    msg = ITEM_IGNORED
-    
-    If dlg.Tag = vbOK Then
-        Dim s As String
-        
-        s = dlg.edItemVal
-        If s <> "" Then
-            AddNewSYS (s)
-            msg = s + ITEM_ADDED
-        End If
-        MsgBox msg
-    End If
-End Sub
-
-Sub AddNewOEM(s As String)
-    Dim r_oem_id As Range
-    Dim r_oem_name As Range
-    Dim r As Range
-    Dim idx As Integer
-    Dim id As Integer
-    Dim ws_name As String
-    
-    With Worksheets(SHEET_OEM_DATA)
-        Set r_oem_id = .Range(RANGE_OEM_ID)
-        Set r_oem_name = .Range(RANGE_OEM_NAME)
-        idx = GetLinesCount(r_oem_id)
-        If idx > 0 Then
-            id = r_oem_id.Offset(idx - 1, 0)
-            r_oem_id.Offset(idx, 0) = id + 1
-        Else
-            r_oem_id = SN_MIN_OEM_ID
-        End If
-        r_oem_name.Offset(idx, 0) = s
-        .Range(RANGE_OEM_IDX) = idx + 1
-        ws_name = "OEM_" & r_oem_id.Offset(idx, 0)
-    End With
-    With Sheets.Add
-        .Name = ws_name
-        With .Buttons.Add(3, 83.25, 39, 16)
-            .OnAction = "to_home"
-            .Characters.Text = "home"
-            .Name = "btHome"
-        End With
-        With .Buttons.Add(3, 101.25, 39, 16)
-            .OnAction = "exportSerial"
-            .Characters.Text = "export"
-            .Name = "btSave"
-        End With
-        .Range("A1") = "OEM"
-        .Range("A2") = "DATE"
-        .Range("A3") = "SOFT"
-        .Range("A4") = "VER"
-        .Range("A5") = "SYS"
-        .Range("A6") = "SERIA"
-        With Cells.Font
-            .Name = "Courier"
-            .Size = 10
-        End With
-        .Protect UserInterfaceonly:=True
-    End With
-    
-    Dim ws As Worksheet
-    Set ws = Worksheets(ws_name)
-    ws.Move After:=Worksheets(Worksheets.Count)
-    
-    Worksheets(SHEET_OEM_KEY).Select
-    Worksheets(SHEET_OEM_DATA).Range(RANGE_OEM_IDX) = idx + 1
-End Sub
-
-Sub AddNewSoft(s As String)
-    Dim r_soft_id As Range
-    Dim r_soft_name As Range
-    Dim r As Range
-    Dim idx As Integer
-    Dim id As Integer
-    
-    With Worksheets(SHEET_OEM_DATA)
-        Set r_soft_id = .Range(RANGE_SOFT_ID)
-        Set r_soft_name = .Range(RANGE_SOFT_NAME)
-        idx = GetLinesCount(r_soft_id)
-        If idx > 0 Then
-            id = r_soft_id.Offset(idx - 1, 0)
-            r_soft_id.Offset(idx, 0) = id + 1
-        Else
-            r_soft_id = SN_MIN_SOFT_ID
-        End If
-        r_soft_name.Offset(idx, 0) = s
-    End With
-    Worksheets(SHEET_OEM_KEY).setup_interface
-    Worksheets(SHEET_OEM_DATA).Range(RANGE_SOFT_IDX) = idx + 1
-End Sub
-
-Sub AddNewSYS(s As String)
-    Dim r_sys_id As Range
-    Dim r_sys_name As Range
-    Dim r As Range
-    Dim idx As Integer
-    Dim id As Integer
-    
-    With Worksheets(SHEET_OEM_DATA)
-        Set r_sys_id = .Range(RANGE_SYS_ID)
-        Set r_sys_name = .Range(RANGE_SYS_NAME)
-        idx = GetLinesCount(r_sys_id)
-        If idx > 0 Then
-            id = r_sys_id.Offset(idx - 1, 0)
-            r_sys_id.Offset(idx, 0) = id + 1
-        Else
-            r_sys_id = SN_MIN_SYS_ID
-        End If
-        r_sys_name.Offset(idx, 0) = s
-    End With
-    Worksheets(SHEET_OEM_KEY).setup_interface
-    Worksheets(SHEET_OEM_DATA).Range(RANGE_SYS_IDX) = idx + 1
-End Sub
-
-Function Get_OEM_Names_Range_Address() As String
-    Dim r As Range
-    Dim s As String
-    Dim l As Long
-
-    With Worksheets(SHEET_OEM_DATA)
-        Set r = .Range(RANGE_OEM_ID)
-        l = GetLinesCount(r) - 1
-        If l < 0 Then
-            l = 0
-        End If
-        
-        s = .Name & "!" & _
-            .Range(.Range(RANGE_OEM_NAME), _
-            .Range(RANGE_OEM_NAME).Offset(l, 0)).Address
-
-    End With
-    Get_OEM_Names_Range_Address = s
-End Function
-
-Function Get_SYS_Names_Range_Address() As String
-    Dim r As Range
-    Dim s As String
-    Dim l As Long
-
-    With Worksheets(SHEET_OEM_DATA)
-        Set r = .Range(RANGE_SYS_ID)
-        l = GetLinesCount(r) - 1
-        If l < 0 Then
-            l = 0
-        End If
-    
-        s = .Name & "!" & _
-            .Range(.Range(RANGE_SYS_NAME), _
-            .Range(RANGE_SYS_NAME).Offset(l, 0)).Address
-    End With
-    Get_SYS_Names_Range_Address = s
-End Function
-
-Function Get_SOFT_Names_Range_Address() As String
-    Dim r As Range
-    Dim s As String
-    Dim l As Long
-
-    With Worksheets(SHEET_OEM_DATA)
-        Set r = .Range(RANGE_SOFT_ID)
-        l = GetLinesCount(r) - 1
-        If l < 0 Then
-            l = 0
-        End If
-        s = .Name & "!" & _
-                .Range(.Range(RANGE_SOFT_NAME), _
-                .Range(RANGE_SOFT_NAME).Offset(l, 0)).Address
-    End With
-    Get_SOFT_Names_Range_Address = s
-End Function
-
-Function Get_OEM_ID_Range_Address() As String
-    Dim r As Range
-    Dim s As String
-    Dim l As Long
-
-    With Worksheets(SHEET_OEM_DATA)
-        Set r = .Range(RANGE_OEM_ID)
-        l = GetLinesCount(r) - 1
-        If l < 0 Then
-            l = 0
-        End If
-        s = .Name & "!" & _
-                .Range(.Range(RANGE_OEM_ID), _
-                .Range(RANGE_OEM_ID).Offset(l, 0)).Address
-    End With
-    Get_OEM_ID_Range_Address = s
-End Function
-
-Function Get_SYS_ID_Range_Address() As String
-    Dim r As Range
-    Dim s As String
-    Dim l As Long
-
-    With Worksheets(SHEET_OEM_DATA)
-        Set r = .Range(RANGE_SYS_ID)
-        l = GetLinesCount(r) - 1
-        If l < 0 Then
-            l = 0
-        End If
-        s = .Name & "!" & _
-            .Range(.Range(RANGE_SYS_ID), _
-            .Range(RANGE_SYS_ID).Offset(l, 0)).Address
-    End With
-    Get_SYS_ID_Range_Address = s
-End Function
-
-Function Get_SOFT_ID_Range_Address() As String
-    Dim r As Range
-    Dim s As String
-    Dim l As Long
-
-    With Worksheets(SHEET_OEM_DATA)
-        Set r = .Range(RANGE_SOFT_ID)
-        l = GetLinesCount(r) - 1
-        If l < 0 Then
-            l = 0
-        End If
-        s = .Name & "!" & _
-            .Range(.Range(RANGE_SOFT_ID), _
-            .Range(RANGE_SOFT_ID).Offset(l, 0)).Address
-    End With
-    Get_SOFT_ID_Range_Address = s
-End Function
-
-
-
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Long
-    Dim n As Long
-    n = 0
-    Do While Location.Offset(n, 0) <> ""
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub hide_sheets()
-    Dim ws As Worksheet
-    Dim wsname As String
-    For Each ws In ThisWorkbook.Worksheets
-        wsname = ws.Name
-        ws.Protect UserInterfaceonly:=True
-        If Left(wsname, 1) = "x" Then
-            ws.EnableCalculation = False
-            ws.Visible = xlSheetVeryHidden
-        End If
-    Next ws
-End Sub
-
-Sub show_sheets()
-    Dim ws As Worksheet
-    Dim wsname As String
-    For Each ws In ThisWorkbook.Worksheets
-        ws.Unprotect
-        wsname = ws.Name
-        If Left(wsname, 1) = "x" Then
-            ws.EnableCalculation = True
-            ws.Visible = xlSheetVisible
-        End If
-    Next ws
-End Sub
-
-Sub check_sn_seria()
-    Dim r1 As Range
-    Dim r2 As Range
-    Dim i As Long
-    Dim j As Long
-    
-    Dim calc_type As Integer
-    calc_type = Application.Calculation
-    Application.Calculation = xlCalculationManual
-    
-    Set r1 = Worksheets("OEM_100").Range("B7")
-    Set r2 = Worksheets("OEM_100").Range("C7")
-        
-    i = GetLinesCount(r1)
-    j = GetLinesCount(r2)
-    
-    Dim as1() As String
-    Dim as2() As String
-    
-    ReDim as1(i)
-    ReDim as2(j)
-    
-    i = 1
-    While r1 <> ""
-        as1(i) = r1
-        as2(i) = r2
-        Set r1 = r1.Offset(1, 0)
-        Set r2 = r2.Offset(1, 0)
-        i = i + 1
-    Wend
-    
-    Set r1 = Worksheets("OEM_100").Range("E6")
-    Set r2 = Worksheets("OEM_100").Range("E7")
-    
-    r1.EntireColumn.ClearContents
-    r1.Offset(0, 1).EntireColumn.ClearContents
-    r1.Select
-    
-    For i = 1 To UBound(as1)
-        r1 = i
-        For j = 1 To UBound(as2)
-            If as1(i) = as2(j) Then
-                r2 = i
-                r2.Offset(0, 1) = j
-                r1.Offset(0, 1) = r1.Offset(0, 1) + 1
-            End If
-        Next j
-    Next i
-    If r2.Row = 7 Then
-        r2 = ";-)"
-    End If
-    Application.Calculation = calc_type
-    Application.Calculate
-End Sub
-
-
-<<<<<<
-======================
-Dec2Hex
->>>>>>
-Attribute VB_Name = "Dec2Hex"
-Option Explicit
-
-
-Const HexNumbers As String = "0123456789ABCDEF"
-Const HexBase As Integer = 16
-Const ThirtyNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRST"
-Const ThirtyBase As Integer = 30
-
-Function sDec2Hex(Dec As Long) As String
-    Dim HexStr As String
-    Dim idx As Integer
-    
-    HexStr = ""
-    
-    If Dec = 0 Then
-        HexStr = Mid(HexNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod HexBase
-            HexStr = Mid(HexNumbers, idx + 1, 1) + HexStr
-            Dec = Dec \ HexBase
-        Wend
-    End If
-    sDec2Hex = HexStr
-End Function
-
-Function Hex2Dec(HexString As String) As Long
-    Dim digit As Integer
-    Dim ch As String
-    Dim hexpower As Integer
-    Dim hexnum As String
-    Dim decnumber As Long
-    
-    hexnum = UCase(HexString)
-    hexpower = 0
-    decnumber = 0
-    
-    While hexnum <> ""
-        ch = Right(hexnum, 1)
-        hexnum = Left(hexnum, Len(hexnum) - 1)
-        digit = InStr(1, HexNumbers, ch, vbBinaryCompare)
-        decnumber = decnumber + digit ' power(hexbase, hexpower)
-        hexpower = hexpower + 1
-    Wend
-    Hex2Dec = decnumber
-End Function
-
-
-
-Function Dec2Thirty(Dec As Long) As String
-
-    
-    Dim ThirtyStr As String
-    Dim idx As Integer
-    
-    ThirtyStr = ""
-    
-    If Dec = 0 Then
-        ThirtyStr = Mid(ThirtyNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtyBase
-            ThirtyStr = Mid(ThirtyNumbers, idx + 1, 1) + ThirtyStr
-            Dec = Dec \ ThirtyBase
-        Wend
-    End If
-    Dec2Thirty = ThirtyStr
-End Function
-
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-OEM_Key
->>>>>>
-Attribute VB_Name = "OEM_Key"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    setup_interface
-End Sub
-
-Sub setup_interface()
-    Dim listsize As Integer
-    Dim r As Range
-    Dim NewCbxRange As String
-    Dim NewCbxSelection As String
-    
-    NewCbxRange = Get_OEM_Names_Range_Address
-    
-    NewCbxSelection = Worksheets(SHEET_OEM_DATA).Name & "!" & _
-                        Worksheets(SHEET_OEM_DATA).Range(RANGE_OEM_IDX).Address
-    Unprotect
-    ActiveSheet.Shapes("oemList").Select
-    With Selection
-        .ListFillRange = NewCbxRange
-        .LinkedCell = NewCbxSelection
-        .DropDownLines = 8
-        .Display3DShading = True
-    End With
-    
-    NewCbxRange = Get_SYS_Names_Range_Address
-    NewCbxSelection = Worksheets(SHEET_OEM_DATA).Name & "!" & _
-                        Worksheets(SHEET_OEM_DATA).Range(RANGE_SYS_IDX).Address
-                        
-    Worksheets(SHEET_OEM_KEY).Shapes("sysList").Select
-    With Selection
-        .ListFillRange = NewCbxRange
-        .LinkedCell = NewCbxSelection
-        .DropDownLines = 8
-        .Display3DShading = True
-    End With
-    Range("Version").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Dec2TS
->>>>>>
-Attribute VB_Name = "Dec2TS"
-Option Explicit
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Double
-    
-    ThirtySixStr = TS
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If ThirtySixStr = "" Then
-        Dec = 0
-    Else
-        While ThirtySixStr <> ""
-            lastdigit = Right(ThirtySixStr, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            ThirtySixStr = Mid(ThirtySixStr, 1, Len(ThirtySixStr) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-
-Function ThirtySix2ChkSum(TS As String) As Integer
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim Dec As Integer
-    
-    ThirtySixStr = TS
-
-    Dec = 0
-    
-    If ThirtySixStr = "" Then
-        Dec = 0
-    Else
-        While ThirtySixStr <> ""
-            lastdigit = Right(ThirtySixStr, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit) - 1
-            Dec = Dec + idx \ 10 + idx Mod 10
-            While Dec > 9
-                Dec = Dec \ 10 + Dec Mod 10
-            Wend
-            ThirtySixStr = Left(ThirtySixStr, Len(ThirtySixStr) - 1)
-        Wend
-    End If
-
-    ThirtySix2ChkSum = Dec
-End Function
-<<<<<<
-======================
-Dec2Hex
->>>>>>
-Attribute VB_Name = "Dec2Hex"
-Option Explicit
-
-
-Const HexNumbers As String = "0123456789ABCDEF"
-Const HexBase As Integer = 16
-Const ThirtyNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRST"
-Const ThirtyBase As Integer = 30
-
-Function sDec2Hex(Dec As Long) As String
-    Dim HexStr As String
-    Dim idx As Integer
-    
-    HexStr = ""
-    
-    If Dec = 0 Then
-        HexStr = Mid(HexNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod HexBase
-            HexStr = Mid(HexNumbers, idx + 1, 1) + HexStr
-            Dec = Dec \ HexBase
-        Wend
-    End If
-    sDec2Hex = HexStr
-End Function
-
-Function Hex2Dec(HexString As String) As Long
-    Dim digit As Integer
-    Dim ch As String
-    Dim hexpower As Integer
-    Dim hexnum As String
-    Dim decnumber As Long
-    
-    hexnum = UCase(HexString)
-    hexpower = 0
-    decnumber = 0
-    
-    While hexnum <> ""
-        ch = Right(hexnum, 1)
-        hexnum = Left(hexnum, Len(hexnum) - 1)
-        digit = InStr(1, HexNumbers, ch, vbBinaryCompare)
-        decnumber = decnumber + digit ' power(hexbase, hexpower)
-        hexpower = hexpower + 1
-    Wend
-    Hex2Dec = decnumber
-End Function
-
-
-
-Function Dec2Thirty(Dec As Long) As String
-
-    
-    Dim ThirtyStr As String
-    Dim idx As Integer
-    
-    ThirtyStr = ""
-    
-    If Dec = 0 Then
-        ThirtyStr = Mid(ThirtyNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtyBase
-            ThirtyStr = Mid(ThirtyNumbers, idx + 1, 1) + ThirtyStr
-            Dec = Dec \ ThirtyBase
-        Wend
-    End If
-    Dec2Thirty = ThirtyStr
-End Function
-
-<<<<<<
-======================
-Serial
->>>>>>
-Attribute VB_Name = "Serial"
-Option Explicit
-
-Function gen_serial() As Long
-    gen_serial = 10000 + Int(Rnd() * 9999) + 1
-End Function
-
-Function gen_root() As Long
-    gen_root = (Rnd() * 8) + 1
-End Function
-
-Function gen_ts_end() As Long
-    gen_ts_end = (Rnd() * 34) + 1
-End Function
-
-Function sn_is_valid_date(dt As String) As Boolean
-    Dim m As Integer
-    Dim d As Integer
-    
-    m = Mid(dt, 2, 2)
-    d = Right(dt, 2)
-    
-    sn_is_valid_date = m < 13 And d < 32
-End Function
-
-Function sn_is_valid_oem(id As Integer) As Boolean
-    Dim r As Range
-    Dim c As Range
-    Dim b As Boolean
-    
-    Set r = Range(Get_OEM_ID_Range_Address)
-    
-    sn_is_valid_oem = False
-    
-    For Each c In r
-        If c = id Then
-            sn_is_valid_oem = True
-            Exit Function
-        End If
-    Next c
-End Function
-
-Function sn_is_valid_sys(id As Integer) As Boolean
-    Dim r As Range
-    Dim c As Range
-    Dim b As Boolean
-    
-    Set r = Range(Get_SYS_ID_Range_Address)
-    
-    sn_is_valid_sys = False
-    
-    For Each c In r
-        If c = id Then
-            sn_is_valid_sys = True
-            Exit Function
-        End If
-    Next c
-End Function
-
-Function sn_check(sn As String) As Boolean
-    Dim s As String
-    Dim chksum As Integer
-    Dim r As Range
-    
-    chksum = Right(sn, 1)
-    s = Left(sn, Len(sn) - 1)
-    
-    Dim cs As Integer
-    cs = ThirtySix2ChkSum(s)
-    
-    sn_check = chksum = cs _
-                And sn_is_valid_date(sn_get_date(sn)) _
-                And sn_is_valid_oem(sn_get_oem_id(sn)) _
-                And sn_is_valid_sys(sn_get_sys_id(sn))
-End Function
-
-Function sn_prefix(sn As String) As String
-    sn_prefix = Left(sn, 3)
-End Function
-
-Function sn_number(sn As String) As String
-    Dim g As Integer
-    Dim g1 As Integer
-    Dim g2 As Integer
-    Dim g3 As Integer
-    g = sn_group(sn)
-    g1 = g \ 100
-    g2 = (g Mod 100) \ 10
-    g3 = g Mod 10
-    Dim s As String
-    s = sn_prefix(sn)
-    s = Mid(sn, Len(s) + 1, g1 + g2 + g3)
-    sn_number = s
-End Function
-
-Function sn_group_one(sn As String) As String
-    Dim s As String
-    Dim r As Integer
-    Dim g As Integer
-    Dim g1 As Integer
-    Dim g2 As Integer
-    Dim g3 As Integer
-    g = sn_group(sn)
-    g1 = g \ 100
-    g2 = (g Mod 100) \ 10
-    g3 = g Mod 10
-    r = sn_root(sn)
-    g = sn_group(sn)
-    s = ROT_Right(sn_number(sn), r)
-    sn_group_one = ThirtySix2Dec(Left(s, g1))
-End Function
-
-Function sn_group_two(sn As String) As String
-    Dim s As String
-    Dim g As Integer
-    Dim r As Integer
-    r = sn_root(sn)
-    s = ROT_Right(sn_number(sn), r)
-    g = sn_group(sn)
-    Dim g1 As Integer
-    Dim g2 As Integer
-    Dim g3 As Integer
-    g1 = g \ 100
-    g2 = (g Mod 100) \ 10
-    g3 = g Mod 10
-    sn_group_two = ThirtySix2Dec(Mid(s, g1 + 1, g2))
-End Function
-
-Function sn_group_three(sn As String) As String
-    Dim s As String
-    Dim g As Integer
-    Dim r As Integer
-    r = sn_root(sn)
-    s = ROT_Right(sn_number(sn), r)
-    g = sn_group(sn)
-    Dim g1 As Integer
-    Dim g2 As Integer
-    Dim g3 As Integer
-    g1 = g \ 100
-    g2 = (g Mod 100) \ 10
-    g3 = g Mod 10
-    sn_group_three = ThirtySix2Dec(Mid(s, g1 + g2 + 1, g3))
-End Function
-
-Function sn_get_sys_id(sn As String) As String
-    Dim s As String
-    Dim d As Long
-    s = sn_group_two(sn)
-    sn_get_sys_id = Right(s, 3)
-End Function
-
-Function sn_get_sys_name(sn As String) As String
-    Dim sys_id As Integer
-    Dim r As Range
-    Dim c As Range
-    Dim s As String
-    sys_id = sn_get_sys_id(sn)
-    s = Get_SYS_ID_Range_Address
-    Set r = Range(s)
-    s = ""
-    
-    For Each c In r
-        If c = sys_id Then
-            s = c.Offset(0, 1)
-            Exit For
-        End If
-    Next c
-    sn_get_sys_name = s
-End Function
-
-Function sn_get_oem_id(sn As String) As String
-    Dim s As String
-    s = sn_group_one(sn)
-    sn_get_oem_id = Left(s, 3)
-End Function
-
-Function sn_get_oem_name(sn As String) As String
-    Dim oem_id As Integer
-    Dim r As Range
-    Dim c As Range
-    Dim s As String
-    oem_id = sn_get_oem_id(sn)
-    s = Get_OEM_ID_Range_Address
-    Set r = Range(s)
-    s = ""
-    
-    For Each c In r
-        If c = oem_id Then
-            s = c.Offset(0, 1)
-            Exit For
-        End If
-    Next c
-    sn_get_oem_name = s
-End Function
-
-Function sn_get_date(sn As String) As String
-    Dim s As String
-    s = sn_group_one(sn)
-    s = Right(s, Len(s) - 3)
-    sn_get_date = s
-End Function
-
-Function sn_get_ver(sn As String) As String
-    Dim s As String
-    s = sn_group_three(sn)
-    s = Left(s, 3)
-    sn_get_ver = s
-End Function
-
-Function sn_get_seria(sn As String) As String
-    Dim s As String
-    s = sn_group_three(sn)
-    s = Right(s, Len(s) - 3)
-    sn_get_seria = s
-End Function
-
-Function sn_root(sn As String) As Integer
-    sn_root = Left(ThirtySix2Dec(sn_prefix(sn)), 1)
-End Function
-
-Function sn_group(sn As String) As Integer
-    Dim s As String
-    s = ThirtySix2Dec(sn_prefix(sn))
-    sn_group = Right(s, Len(s) - 1)
-End Function
-
-Function Rotate_Left(r As Range, position As Integer) As String
-    Dim r_str As String
-    r_str = r
-    Rotate_Left = ROT_Left(r_str, position)
-End Function
-
-Function ROT_Left(s As String, position As Integer) As String
-    Dim i As Integer
-    Dim slen As Integer
-    
-    Dim r_str As String
-    Dim ch As String
-    
-    r_str = s
-    
-    slen = Len(r_str)
-    For i = 1 To position
-        ch = Left(r_str, 1)
-        r_str = Right(r_str, slen - 1)
-        r_str = r_str + ch
-    Next i
-    
-    ROT_Left = r_str
-End Function
-
-Function Rotate_Right(r As Range, position As Integer) As String
-    Dim r_str As String
-    r_str = r
-    Rotate_Right = ROT_Right(r_str, position)
-End Function
-
-Function ROT_Right(s As String, position As Integer) As String
-    Dim i As Integer
-    Dim slen As Integer
-    
-    Dim r_str As String
-    Dim ch As String
-    
-    r_str = s
-    
-    slen = Len(r_str)
-    For i = 1 To position
-        ch = Right(r_str, 1)
-        r_str = Left(r_str, slen - 1)
-        r_str = ch + r_str
-    Next i
-    
-    ROT_Right = r_str
-End Function
-
-
-<<<<<<
-======================
-OEM_DATA
->>>>>>
-Attribute VB_Name = "OEM_DATA"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-newOEMdlg
->>>>>>
-Attribute VB_Name = "newOEMdlg"
-Attribute VB_Base = "0{39393DC9-744B-4C17-88BD-5C508F5FD702}{EAA9566B-3F9C-455E-908D-B3794AD3044C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub AddOEM_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub resetOEM_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-<<<<<<
-======================
-interface
->>>>>>
-Attribute VB_Name = "interface"
-Option Explicit
-
-Public Const SHEET_OEM_DATA As String = "OEM_DATA"
-Public Const SHEET_OEM_KEY As String = "OEM_Key"
-
-Public Const RANGE_OEM_IDX As String = "OEM_IDX"
-Public Const RANGE_OEM_ID As String = "OEM_ID"
-Public Const RANGE_OEM_NAME As String = "OEM_NAME"
-
-Public Const RANGE_SYS_IDX As String = "SYS_IDX"
-Public Const RANGE_SYS_ID As String = "SYS_ID"
-Public Const RANGE_SYS_NAME As String = "SYS_NAME"
-
-Sub export()
-    Dim fs As Object
-    Dim a As Object
-    Dim fpath As String
-    Dim fname As String
-    Dim r As Range
-    
-    fpath = GetWBPath(ThisWorkbook.FullName)
-    fname = GetExFileName()
-    If fname = "" Then
-        MsgBox ("=8-(")
-        Exit Sub
-    End If
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    fname = fpath & fname & ".txt"
-    Set a = fs.CreateTextFile(fname, True)
-    
-    Set r = Range(GetLastRange).Offset(4, 0)
-    While r <> ""
-        a.WriteLine (r)
-        Set r = r.Offset(1, 0)
-    Wend
-    a.Close
-    MsgBox ("saved in:" & fname & " ;-)")
-End Sub
-
-Function GetLastRange() As String
-    Dim r As Range
-    Set r = ActiveSheet.Range("A1")
-    While r.Offset(0, 1) <> ""
-        Set r = r.Offset(0, 1)
-    Wend
-    GetLastRange = r.Address
-End Function
-
-Function GetExFileName() As String
-    Dim s As String
-    Dim r As Range
-    s = ""
-    Set r = Range(GetLastRange)
-    If r <> ActiveSheet.Range("A1") Then
-        s = r & "_" _
-            & r.Offset(1, 0) & "_" _
-            & r.Offset(2, 0) & "_" _
-            & r.Offset(3, 0) & "_" _
-            & r.Offset(4, 0)
-    End If
-    GetExFileName = s
-End Function
-
-Function get_oem_sheet_name() As String
-    Dim oem_id As Integer
-    With Worksheets(SHEET_OEM_DATA)
-        oem_id = .Range(RANGE_OEM_IDX)
-        oem_id = .Range(RANGE_OEM_ID).Offset(oem_id - 1, 0)
-    End With
-    get_oem_sheet_name = "OEM_" & oem_id
-End Function
-
-Sub gotooem()
-    With Worksheets(get_oem_sheet_name)
-        .Select
-        .Range("A1").Select
-        .Protect UserInterfaceOnly:=True
-    End With
-End Sub
-
-Sub home()
-    Worksheets(SHEET_OEM_KEY).Select
-End Sub
-
-Sub oemAdd_Click()
-    Dim dlg As newOEMdlg
-    Set dlg = New newOEMdlg
-    
-    dlg.Show
-
-    If dlg.Tag = vbOK Then
-        Dim s As String
-        s = dlg.edOEM_Name
-        AddNewOEM (s)
-        MsgBox ":)"
-    End If
-End Sub
-
-Sub sysAdd_Click()
-    Dim dlg As newSYSdlg
-    Set dlg = New newSYSdlg
-    
-    dlg.Show
-
-    If dlg.Tag = vbOK Then
-        Dim s As String
-        s = dlg.edSYS_Name
-        AddNewSYS (s)
-        MsgBox ":)"
-    End If
-End Sub
-
-Sub AddNewOEM(s As String)
-    Dim r_oem_id As Range
-    Dim r_oem_name As Range
-    Dim r As Range
-    Dim idx As Integer
-    Dim id As Integer
-    
-    With Worksheets(SHEET_OEM_DATA)
-        Set r_oem_id = .Range(RANGE_OEM_ID)
-        Set r_oem_name = .Range(RANGE_OEM_NAME)
-        idx = GetLinesCount(r_oem_id)
-        id = r_oem_id.Offset(idx - 1, 0)
-        r_oem_id.Offset(idx, 0) = id + 1
-        r_oem_name.Offset(idx, 0) = s
-    End With
-    With Sheets.Add
-        .Name = "OEM_" & r_oem_id.Offset(idx, 0)
-        With .Buttons.Add(3, 69.75, 39, 16)
-            .OnAction = "home"
-            .Characters.Text = "home"
-            .Name = "btHome"
-        End With
-        With .Buttons.Add(3, 87.75, 39, 16)
-            .OnAction = "export"
-            .Characters.Text = "export"
-            .Name = "btSave"
-        End With
-        .Range("A1") = "OEM"
-        .Range("A2") = "DATE"
-        .Range("A3") = "VER"
-        .Range("A4") = "SYS"
-        .Range("A5") = "SERIA"
-        With Cells.Font
-            .Name = "Courier"
-            .Size = 10
-        End With
-        .Protect UserInterfaceOnly:=True
-    End With
-    Worksheets(SHEET_OEM_KEY).Select
-    Worksheets(SHEET_OEM_KEY).setup_interface
-End Sub
-
-Sub AddNewSYS(s As String)
-    Dim r_sys_id As Range
-    Dim r_sys_name As Range
-    Dim r As Range
-    Dim idx As Integer
-    Dim id As Integer
-    
-    With Worksheets(SHEET_OEM_DATA)
-        Set r_sys_id = .Range(RANGE_SYS_ID)
-        Set r_sys_name = .Range(RANGE_SYS_NAME)
-        idx = GetLinesCount(r_sys_id)
-        id = r_sys_id.Offset(idx - 1, 0)
-        r_sys_id.Offset(idx, 0) = id + 1
-        r_sys_name.Offset(idx, 0) = s
-    End With
-    Worksheets(SHEET_OEM_KEY).setup_interface
-End Sub
-
-Function Get_OEM_Names_Range_Address() As String
-    Dim r As Range
-    Dim s As String
-
-    With Worksheets(SHEET_OEM_DATA)
-        Set r = .Range(RANGE_OEM_ID)
-        s = .Name & "!" & _
-            .Range(.Range(RANGE_OEM_NAME), _
-            .Range(RANGE_OEM_NAME).Offset(GetLinesCount(r) - 1, 0)).Address
-
-    End With
-    Get_OEM_Names_Range_Address = s
-End Function
-
-Function Get_SYS_Names_Range_Address() As String
-    Dim r As Range
-    Dim s As String
-
-    With Worksheets(SHEET_OEM_DATA)
-        Set r = .Range(RANGE_SYS_ID)
-    
-        s = .Name & "!" & _
-            .Range(.Range(RANGE_SYS_NAME), _
-            .Range(RANGE_SYS_NAME).Offset(GetLinesCount(r) - 1, 0)).Address
-    End With
-    Get_SYS_Names_Range_Address = s
-End Function
-
-Function Get_OEM_ID_Range_Address() As String
-    Dim r As Range
-    Dim s As String
-
-    With Worksheets(SHEET_OEM_DATA)
-        Set r = .Range(RANGE_OEM_ID)
-        s = .Name & "!" & _
-            .Range(.Range(RANGE_OEM_ID), _
-            .Range(RANGE_OEM_ID).Offset(GetLinesCount(r) - 1, 0)).Address
-
-    End With
-    Get_OEM_ID_Range_Address = s
-End Function
-
-Function Get_SYS_ID_Range_Address() As String
-    Dim r As Range
-    Dim s As String
-
-    With Worksheets(SHEET_OEM_DATA)
-        Set r = .Range(RANGE_SYS_ID)
-    
-        s = .Name & "!" & _
-            .Range(.Range(RANGE_SYS_ID), _
-            .Range(RANGE_SYS_ID).Offset(GetLinesCount(r) - 1, 0)).Address
-    End With
-    Get_SYS_ID_Range_Address = s
-End Function
-
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Long
-    Dim n As Long
-    n = 0
-    Do While Location.Offset(n, 0) <> ""
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub check_sn_seria()
-    Dim r1 As Range
-    Dim r2 As Range
-    Dim i As Long
-    Dim j As Long
-    
-    Dim calc_type As Integer
-    calc_type = Application.Calculation
-    Application.Calculation = xlCalculationManual
-    
-    Set r1 = Worksheets("OEM_100").Range("B6")
-    Set r2 = Worksheets("OEM_100").Range("C6")
-        
-    i = GetLinesCount(r1)
-    j = GetLinesCount(r2)
-    
-    Dim as1() As String
-    Dim as2() As String
-    
-    ReDim as1(i)
-    ReDim as2(j)
-    
-    i = 1
-    While r1 <> ""
-        as1(i) = r1
-        as2(i) = r2
-        Set r1 = r1.Offset(1, 0)
-        Set r2 = r2.Offset(1, 0)
-        i = i + 1
-    Wend
-    
-    
-    Set r1 = Worksheets("OEM_100").Range("E5")
-    Set r2 = Worksheets("OEM_100").Range("E6")
-    
-    r1.EntireColumn.ClearContents
-    r1.Offset(0, 1).EntireColumn.ClearContents
-    r1.Select
-    
-    For i = 1 To UBound(as1)
-        r1 = i
-        For j = 1 To UBound(as2)
-            If as1(i) = as2(j) Then
-                r2 = i
-                r2.Offset(0, 1) = j
-                r1.Offset(0, 1) = r1.Offset(0, 1) + 1
-                Set r2 = r2.Offset(1, 0)
-            End If
-        Next j
-    Next i
-    If r2.Row = 6 Then
-        r2 = ";-)"
-    End If
-    Application.Calculation = calc_type
-    Application.Calculate
-End Sub
-
-<<<<<<
-======================
-Generator
->>>>>>
-Attribute VB_Name = "Generator"
-Option Explicit
-
-Sub snCreate_Click()
-    Dim d_date As Long
-    Dim seria As Long
-    Dim version As Integer
-    Dim oem_id As Integer
-    Dim sys_id As Integer
-    Dim i As Long
-    Dim r As Range
-    
-    With Worksheets(SHEET_OEM_KEY)
-        version = .Range("Version")
-        seria = .Range("Seria")
-    End With
-
-    With Worksheets(SHEET_OEM_DATA)
-        oem_id = .Range(RANGE_OEM_IDX)
-        oem_id = .Range(RANGE_OEM_ID).Offset(oem_id - 1, 0)
-        sys_id = .Range(RANGE_SYS_IDX)
-        sys_id = .Range(RANGE_SYS_ID).Offset(sys_id - 1, 0)
-    End With
-    
-    d_date = (Year(Now()) Mod 10)
-    d_date = d_date * 10000
-    d_date = d_date + Month(Now()) * 100
-    d_date = d_date + Day(Now())
-    
-    Dim calc_type As Integer
-    calc_type = Application.Calculation
-    Application.Calculation = xlCalculationManual
-    
-    Dim oem_wks As String
-    oem_wks = get_oem_sheet_name
-    Set r = Worksheets(oem_wks).Range("A1")
-    While r <> ""
-        Set r = r.Offset(0, 1)
-    Wend
-    
-    r.Offset(0, 0) = oem_id
-    r.Offset(1, 0) = d_date
-    r.Offset(2, 0) = version
-    r.Offset(3, 0) = sys_id
-    r.Offset(4, 0) = seria
-    
-    Randomize
-    
-    For i = 1 To seria
-        r.Offset(4 + i) = SN_Generate(d_date, oem_id, sys_id, version, seria)
-    Next i
-    r.EntireColumn.AutoFit
-    r.Worksheet.Select
-    r.Select
-    
-    Application.Calculation = calc_type
-    Application.Calculate
-End Sub
-
-Function SN_Generate(d_date As Long, oem_id As Integer, sys_id As Integer, version As Integer, seria As Long) As String
-    Dim sn_number As Long
-    Dim s_one As String
-    Dim s_two As String
-    Dim s_three As String
-    Dim s_sn As String
-    Dim s_idx As String
-    Dim sn_root As Integer
-    Dim sn_chk As Integer
-    
-    sn_number = gen_serial
-    sn_root = gen_root
-    
-    s_one = oem_id & d_date
-    s_two = sn_number & sys_id
-    s_three = version & seria
-    
-    s_one = Dec2ThirtySix(Format(s_one, "#"))
-    s_two = Dec2ThirtySix(Format(s_two, "#"))
-    s_three = Dec2ThirtySix(Format(s_three, "#"))
-    
-    s_sn = s_one & s_two & s_three
-    
-    s_sn = ROT_Left(s_sn, sn_root)
-    
-    s_idx = sn_root & Len(s_one) & Len(s_two) & Len(s_three)
-    
-    s_idx = Dec2ThirtySix(Format(s_idx, "#"))
-    
-    s_sn = s_idx & s_sn
-    
-    While Len(s_sn) < 19
-        Dim s As String
-        s = Dec2ThirtySix(gen_ts_end)
-        s_sn = s_sn & s
-    Wend
-    
-    sn_chk = ThirtySix2ChkSum(s_sn)
-    
-    s_sn = s_sn & sn_chk
-    
-    SN_Generate = Left(s_sn, 5) _
-            & " " & Mid(s_sn, 6, 5) _
-            & " " & Mid(s_sn, 11, 5) _
-            & " " & Right(s_sn, Len(s_sn) - 15)
-End Function
-<<<<<<
-======================
-newSYSdlg
->>>>>>
-Attribute VB_Name = "newSYSdlg"
-Attribute VB_Base = "0{059C105D-BD13-41AB-9A28-A61478F592F8}{830FC1D2-6497-4B79-BC07-D219C00B138A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub AddSYS_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub resetSYS_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-L112
->>>>>>
-Attribute VB_Name = "L112"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-templ
->>>>>>
-Attribute VB_Name = "templ"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LabPrn
->>>>>>
-Attribute VB_Name = "LabPrn"
-Option Explicit
-
-Sub printLab()
-    On Error GoTo handleCancel
-    Application.EnableCancelKey = xlErrorHandler
-    Dim x As Integer
-    Dim x_stop As Integer
-    Dim SerIdx As Range
-    Dim SerLen As Range
-    Dim PrintSeria As Range
-    Dim PrintIdx As Range
-    Dim NextGen As Range
-    Dim snlist As Range
-        
-    With ThisWorkbook.Worksheets("SERIA")
-        Set SerIdx = .Range("SeriaIdx")
-        Set SerLen = .Range("SeriaLen")
-        Set snlist = .Range("SeriaList")
-    End With
-    With ThisWorkbook.Worksheets("templ")
-        Set PrintSeria = .Range("PrintSeria")
-        Set PrintIdx = .Range("PrintIdx")
-        Set NextGen = .Range("NextGen")
-    End With
-    
-    x_stop = SerIdx + NextGen
-    For x = SerIdx To x_stop
-        PrintSeria = snlist.Item(x, 1)
-        PrintIdx = x
-        SerIdx = x + 1
-        ThisWorkbook.Worksheets("templ").PrintOut Copies:=1, Collate:=True
-    Next x
-
-handleCancel:
-    If Err = 18 Then
-    End If
-    
-    ThisWorkbook.Save
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Unprotect "password"
-    ThisWorkbook.Save
-End Sub
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Protect password:="password"
-    Worksheets("Calc").Protect password:="password", userInterfaceonly:=True
-    Worksheets("Calc").Select
-    Worksheets("Calc").Range("A7").Select
-End Sub
-<<<<<<
-======================
-Calc
->>>>>>
-Attribute VB_Name = "Calc"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Sub SelectAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOn
-        End If
-    Next Sh
-    Range("A7").Select
-End Sub
-
-Sub ClearAll()
-    Dim Sh As Shape
-    For Each Sh In Shapes
-        If InStr(1, Sh.Name, "Check") Then
-            Sh.Select
-            Selection.Value = xlOff
-        End If
-    Next Sh
-    Range("A7").Select
-    Worksheets("Data").Range("K2") = 1
-    Worksheets("Calc").Range("E58") = 1
-End Sub
-
-<<<<<<
-======================
-Data
->>>>>>
-Attribute VB_Name = "Data"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Const bak As String = "backup"
-
-Private Sub Workbook_Open()
-    Dim n As String
-    Dim e As String
-    Dim d As String
-    n = ThisWorkbook.FullName
-    e = Right(n, 4)
-    n = Left(n, Len(n) - 4)
-    Dim nt As String
-    nt = Right(n, Len(bak))
-    If nt <> bak Then
-        d = Date$
-        n = n + "_" + d + "_" + bak + e
-        ThisWorkbook.SaveCopyAs n
-    End If
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet22
->>>>>>
-Attribute VB_Name = "Sheet22"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet23
->>>>>>
-Attribute VB_Name = "Sheet23"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet24
->>>>>>
-Attribute VB_Name = "Sheet24"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet25
->>>>>>
-Attribute VB_Name = "Sheet25"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-xTEST_NUM
->>>>>>
-Attribute VB_Name = "xTEST_NUM"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mSerialTNT
->>>>>>
-Attribute VB_Name = "mSerialTNT"
-Option Explicit
-Const MAX_NUM1 As Integer = ThirtySixBase
-Const MAX_NUM2 As Integer = ThirtySixBase ^ 2 / 2
-Const MAX_NUM3 As Integer = ThirtySixBase
-
-Const USERID_BASE As Long = ThirtySixBase ^ 3
-
-Const SRVC_BASE As Integer = 1000
-Const SRVC_MAX As Integer = 1999
-
-Const ORG_BASE As Integer = 100
-Const ORG_MAX As Integer = 199
-
-Sub test()
-    Dim user() As String
-    Dim i
-    Dim r As Range
-    Dim s As String
-    
-    Application.ScreenUpdating = False
-    
-    Dim calc_type As Integer
-    calc_type = Application.Calculation
-    Application.Calculation = xlCalculationManual
-   
-    Set r = Worksheets("TEST_SN").Range("B3")
-    For i = 0 To 50000
-        user = getNextSerial(1000, 100)
-        r = "'" & user(1)
-        r.Offset(0, 1) = "'" & user(2)
-        r.Offset(0, 2) = Len(user(1))
-        r.Offset(0, 3) = Len(user(2))
-        If i <> 0 Then
-            s = "=IF(" & r.Address & "=" & r.Offset(-1, 0).Address & ",1,0)"
-            r.Offset(0, 4).Formula = s
-        End If
-        Set r = r.Offset(1, 0)
-    Next i
-    
-    Application.Calculation = calc_type
-    Application.ScreenUpdating = False
-
-End Sub
-
-Function getNextSerial(srv As Integer, org As Integer) As String()
-    Dim num1 As Integer
-    Dim num2 As Integer
-    Dim num3 As Integer
-    Dim rdate As Long
-    Dim userID As Long
-    
-    num1 = nextNumber(MAX_NUM1)
-    num2 = nextNumber(MAX_NUM2)
-    num3 = nextNumber(MAX_NUM3)
-    
-    rdate = get_sn_date
-    
-    userID = nextUserID
-    
-    Dim serial As String
-    
-    serial = "" & srv & org & rdate & userID & num1 & num2 & num3
-    
-    Dim serial_SN As Integer
-    
-    serial_SN = get_serial_check_sum(serial)
-    
-    Dim login_1 As Long
-    Dim login_2 As Long
-    
-    Dim pass_1 As Long
-    Dim pass_2 As Long
-    
-    login_1 = "" & userID & serial_SN
-    login_2 = "" & num3 & rdate
-    
-    pass_1 = "" & num1 & srv
-    pass_2 = "" & num2 & org
-    
-    Dim out(2) As String
-    out(1) = Dec2ThirtySix(login_1) & Dec2ThirtySix(login_2)
-    out(2) = Dec2ThirtySix(pass_1) & Dec2ThirtySix(pass_2)
-    
-    getNextSerial = out
-End Function
-
-Function get_serial_check_sum(id_sn As String) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim chk As Integer
-    
-    s = id_sn
-    chk = 0
-    While s <> ""
-        i = Left(s, 1)
-        chk = (chk + i) Mod 10
-        s = Right(s, Len(s) - 1)
-    Wend
-    get_serial_check_sum = chk
-End Function
-
-Function get_sn_date() As Long
-    Dim d_date As Long
-    d_date = (Year(Now()) Mod 10)
-    d_date = d_date * 10000
-    d_date = d_date + Month(Now()) * 100
-    d_date = d_date + Day(Now())
-    get_sn_date = d_date
-End Function
-
-Function nextUserID() As Long
-    nextUserID = USERID_BASE + Int(Rnd() * USERID_BASE)
-End Function
-
-Function nextNumber(base As Integer) As Integer
-    nextNumber = base + Int(Rnd() * base)
-End Function
-
-Function serial_check_id_sum(id_sn As String) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim chk As Integer
-    
-    s = id_sn
-    chk = 0
-    While s <> ""
-        i = Left(s, 1)
-        chk = (chk + i) Mod 10
-        s = Right(s, Len(s) - 1)
-    Wend
-    serial_check_id_sum = chk
-End Function
-
-<<<<<<
-======================
-xTEST_SER
->>>>>>
-Attribute VB_Name = "xTEST_SER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Dec2TS
->>>>>>
-Attribute VB_Name = "Dec2TS"
-Option Explicit
-
-'Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-'Const ThirtySixBase As Integer = 36
-
-Public Const ThirtySixNumbers As String = "123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
-Public Const ThirtySixBase As Integer = 34
-
-Function randSN(Optional n As Integer = 34) As String
-    Dim t(ThirtySixBase) As String
-    Dim i As Integer
-    Dim j, k As Integer
-    Dim r As String
-    
-    For i = 1 To UBound(t)
-        t(i) = Mid(ThirtySixNumbers, i, 1)
-    Next i
-    For i = 1 To n
-        j = Int((ThirtySixBase * Rnd) + 1)
-        k = i Mod ThirtySixBase + 1
-        r = t(k)
-        t(k) = t(j)
-        t(j) = r
-    Next i
-    r = ""
-    For i = 1 To UBound(t)
-        r = r + t(i)
-    Next i
-    randSN = r
-End Function
-Function Dec2ThirtySix(ByVal Dec As Long) As String
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Double
-    
-    ThirtySixStr = TS
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If ThirtySixStr = "" Then
-        Dec = 0
-    Else
-        While ThirtySixStr <> ""
-            lastdigit = Right(ThirtySixStr, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            ThirtySixStr = Mid(ThirtySixStr, 1, Len(ThirtySixStr) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-
-Sub test()
-    Dim l As Long
-    l = ThirtySix2Dec("2HPI")
-    l = ThirtySix2ChkSum("2HPI")
-End Sub
-
-Function ThirtySix2ChkSum(TS As String) As Integer
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim chksum As Integer
-    
-    ThirtySixStr = TS
-
-    chksum = 0
-    
-    If ThirtySixStr = "" Then
-        chksum = 0
-    Else
-        While ThirtySixStr <> ""
-            lastdigit = Right(ThirtySixStr, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit) - 1
-            chksum = (chksum + idx) Mod ThirtySixBase
-            ThirtySixStr = Left(ThirtySixStr, Len(ThirtySixStr) - 1)
-        Wend
-    End If
-
-    ThirtySix2ChkSum = chksum
-End Function
-<<<<<<
-======================
-newItemDlg
->>>>>>
-Attribute VB_Name = "newItemDlg"
-Attribute VB_Base = "0{0B5E9521-7808-446E-9E61-7D38E1C2651A}{1C691B41-AC71-4558-927D-1487F1C50C72}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub AddSYS_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub resetSYS_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-<<<<<<
-======================
-Dec2Hex
->>>>>>
-Attribute VB_Name = "Dec2Hex"
-Option Explicit
-
-
-Const HexNumbers As String = "0123456789ABCDEF"
-Const HexBase As Integer = 16
-Const ThirtyNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRST"
-Const ThirtyBase As Integer = 30
-
-Function sDec2Hex(Dec As Long) As String
-    Dim HexStr As String
-    Dim idx As Integer
-    
-    HexStr = ""
-    
-    If Dec = 0 Then
-        HexStr = Mid(HexNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod HexBase
-            HexStr = Mid(HexNumbers, idx + 1, 1) + HexStr
-            Dec = Dec \ HexBase
-        Wend
-    End If
-    sDec2Hex = HexStr
-End Function
-
-Function Hex2Dec(HexString As String) As Long
-    Dim digit As Integer
-    Dim ch As String
-    Dim hexpower As Integer
-    Dim hexnum As String
-    Dim decnumber As Long
-    
-    hexnum = UCase(HexString)
-    hexpower = 0
-    decnumber = 0
-    
-    While hexnum <> ""
-        ch = Right(hexnum, 1)
-        hexnum = Left(hexnum, Len(hexnum) - 1)
-        digit = InStr(1, HexNumbers, ch, vbBinaryCompare)
-        decnumber = decnumber + digit ' power(hexbase, hexpower)
-        hexpower = hexpower + 1
-    Wend
-    Hex2Dec = decnumber
-End Function
-
-
-
-Function Dec2Thirty(Dec As Long) As String
-    
-    Dim ThirtyStr As String
-    Dim idx As Integer
-    
-    ThirtyStr = ""
-    
-    If Dec = 0 Then
-        ThirtyStr = Mid(ThirtyNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtyBase
-            ThirtyStr = Mid(ThirtyNumbers, idx + 1, 1) + ThirtyStr
-            Dec = Dec \ ThirtyBase
-        Wend
-    End If
-    Dec2Thirty = ThirtyStr
-End Function
-
-<<<<<<
-======================
-TEST_SN
->>>>>>
-Attribute VB_Name = "TEST_SN"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ETIME
->>>>>>
-Attribute VB_Name = "ETIME"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Long
-    Dim n As Long
-    n = 0
-    Do While Location.Offset(n, 0) <> ""
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub hide_sheets()
-    Dim ws As Worksheet
-    Dim wsname As String
-    For Each ws In ThisWorkbook.Worksheets
-        wsname = ws.Name
-        ws.Protect UserInterfaceonly:=True
-        If Left(wsname, 1) = "x" Then
-            ws.EnableCalculation = False
-            ws.Visible = xlSheetVeryHidden
-        End If
-    Next ws
-End Sub
-
-Sub show_sheets()
-    Dim ws As Worksheet
-    Dim wsname As String
-    For Each ws In ThisWorkbook.Worksheets
-        ws.Unprotect
-        wsname = ws.Name
-        If Left(wsname, 1) = "x" Then
-            ws.EnableCalculation = True
-            ws.Visible = xlSheetVisible
-        End If
-    Next ws
-End Sub
-
-Sub check_sn_seria()
-    Dim r1 As Range
-    Dim r2 As Range
-    Dim i As Long
-    Dim j As Long
-    
-    Dim calc_type As Integer
-    calc_type = Application.Calculation
-    Application.Calculation = xlCalculationManual
-    
-    Set r1 = Worksheets("OEM_100").Range("B7")
-    Set r2 = Worksheets("OEM_100").Range("C7")
-        
-    i = GetLinesCount(r1)
-    j = GetLinesCount(r2)
-    
-    Dim as1() As String
-    Dim as2() As String
-    
-    ReDim as1(i)
-    ReDim as2(j)
-    
-    i = 1
-    While r1 <> ""
-        as1(i) = r1
-        as2(i) = r2
-        Set r1 = r1.Offset(1, 0)
-        Set r2 = r2.Offset(1, 0)
-        i = i + 1
-    Wend
-    
-    Set r1 = Worksheets("OEM_100").Range("E6")
-    Set r2 = Worksheets("OEM_100").Range("E7")
-    
-    r1.EntireColumn.ClearContents
-    r1.Offset(0, 1).EntireColumn.ClearContents
-    r1.Select
-    
-    For i = 1 To UBound(as1)
-        r1 = i
-        For j = 1 To UBound(as2)
-            If as1(i) = as2(j) Then
-                r2 = i
-                r2.Offset(0, 1) = j
-                r1.Offset(0, 1) = r1.Offset(0, 1) + 1
-            End If
-        Next j
-    Next i
-    If r2.Row = 7 Then
-        r2 = ";-)"
-    End If
-    Application.Calculation = calc_type
-    Application.Calculate
-End Sub
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Sub Dom2_Stat()
-    Dim sr As Range
-    
-    Set sr = Worksheets("DOM2-Stat1w").Range("c7:e54")
-    
-    DelAllBlanks sr
-End Sub
-
-Sub Dom2_Stat2()
-    Dim sr As Range
-    
-    Set sr = Worksheets("DOM2-Stat2w").Range("e7:e92")
-    
-    DelAllPercentage sr
-End Sub
-
-Sub DelAllBlanks(ByRef r As Range)
-    Dim c As Range
-    Dim s_in As String
-    Dim s_out As String
-    Dim spaceIdx As Integer
-    
-    For Each c In r
-        s_in = c.Value2
-        s_out = Left(s_in, Len(s_in) - 4) + Right(s_in, 3)
-        c = s_out
-        c.NumberFormat = "###"
-    Next c
-End Sub
-
-Sub DelAllPercentage(ByRef r As Range)
-    Dim c As Range
-    Dim s_in As String
-    Dim s_out As String
-    Dim spaceIdx As Integer
-    
-    For Each c In r
-        s_in = c.Value2
-        s_in = Left(s_in, InStr(s_in, "(") - 2)
-        If Len(s_in) > 4 Then
-            s_out = Left(s_in, Len(s_in) - 4) + Right(s_in, 3)
-        Else
-            s_out = s_in
-        End If
-        c = s_out
-        c.NumberFormat = "###"
-    Next c
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Digit2String
->>>>>>
-Attribute VB_Name = "Digit2String"
-Sub main()
-
-Dim dd As Double
-Dim st As String
-
-dd = 21.2234
-
-' 0 - rub
-' 1 - y.e.
-
-st = Digit2String(dd, 1)
-
-End Sub
-
-Function Digit2String(digit As Double, p As Integer) As String
-
-' ������ ������� 18.06.01 mikle-2
-Dim W1(20) As String
-Dim W1a(20) As String
-Dim W10(10) As String
-Dim W100(10) As String
-Dim W1000(10) As String
-
-W1(0) = ""
-W1(1) = "����"
-W1(2) = "���"
-W1(3) = "���"
-W1(4) = "������"
-W1(5) = "����"
-W1(6) = "�����"
-W1(7) = "����"
-W1(8) = "������"
-W1(9) = "������"
-W1(10) = "������"
-W1(11) = "����������"
-W1(12) = "����������"
-W1(13) = "����������"
-W1(14) = "������������"
-W1(15) = "����������"
-W1(16) = "�����������"
-W1(17) = "����������"
-W1(18) = "������������"
-W1(19) = "������������"
-W1a(0) = ""
-W1a(1) = "����"
-W1a(2) = "���"
-W1a(3) = "���"
-W1a(4) = "������"
-W1a(5) = "����"
-W1a(6) = "�����"
-W1a(7) = "����"
-W1a(8) = "������"
-W1a(9) = "������"
-W1a(10) = "������"
-W1a(11) = "����������"
-W1a(12) = "����������"
-W1a(13) = "����������"
-W1a(14) = "������������"
-W1a(15) = "����������"
-W1a(16) = "�����������"
-W1a(17) = "����������"
-W1a(18) = "������������"
-W1a(19) = "������������"
-W10(0) = ""
-W10(1) = "������"
-W10(2) = "��������"
-W10(3) = "��������"
-W10(4) = "�����"
-W10(5) = "���������"
-W10(6) = "����������"
-W10(7) = "���������"
-W10(8) = "�����������"
-W10(9) = "���������"
-W100(0) = ""
-W100(1) = "���"
-W100(2) = "������"
-W100(3) = "������"
-W100(4) = "���������"
-W100(5) = "�������"
-W100(6) = "��������"
-W100(7) = "�������"
-W100(8) = "���������"
-W100(9) = "���������"
-
-Result = ""
-
-e = Int((digit - Int(digit)) * 100) ' decimal
-digit_long = Int(digit)
-a = Int(digit_long / 1000000) '32123456/1000000 = 32 -> 10^6
-b = digit_long - (a * 1000000) '32123456-32000000 = 123456
-c = Int(b / 1000) '123456/1000 = 123 -> 10^3
-d = b - (c * 1000) '123456-123*1000 = 456 -> 1
-
-Add = ""
-For i = 2 To 0 Step -1
-    m = Int(a / (10 ^ i))
-    If i = 2 Then
-        If m <> 0 Then
-            R = W100(m) + " "
-            Add = "��������� "
-        End If
-    End If
-    If i = 1 Then
-        If m <> 0 Then
-            If a < 20 Then
-                Result = Result + W1(a) + " ��������� "
-                GoTo con_0
-            End If
-            R = W10(m) + " "
-            Add = "��������� "
-        End If
-    End If
-    If i = 0 Then
-        If m <> 0 Then
-            If m >= 5 Then
-                R = W1(m) + " "
-                Add = "��������� "
-            End If
-            If m <= 4 Then
-                R = W1(m) + " "
-                Add = "�������� "
-            End If
-            If m = 1 Then
-                R = "���� "
-                Add = "������� "
-            End If
-        End If
-        
-    End If
-    a = a - (m * (10 ^ i))
-    Result = Result + R
-    R = ""
-Next i
-Result = Result + Add
-con_0:
-
-Add = ""
-For i = 2 To 0 Step -1
-    m = Int(c / (10 ^ i))
-    If i = 2 Then
-        If m <> 0 Then
-            R = W100(m) + " "
-            Add = "����� "
-        End If
-    End If
-    If i = 1 Then
-        If m <> 0 Then
-            If c < 20 Then
-                Result = Result + W1(c) + " ����� "
-                GoTo con_1
-            End If
-            R = W10(m) + " "
-            Add = "����� "
-        End If
-    End If
-    If i = 0 Then
-        If m <> 0 Then
-            If m >= 5 Then
-                R = W1(m) + " "
-                Add = "����� "
-            End If
-            If m <= 4 Then
-                R = W1(m) + " "
-                Add = "������ "
-            End If
-            If m = 2 Then
-                R = "��� "
-                Add = "������ "
-            End If
-            If m = 1 Then
-                R = "���� "
-                Add = "������ "
-            End If
-        End If
-    End If
-    c = c - (m * (10 ^ i))
-    Result = Result + R
-    R = ""
-Next i
-Result = Result + Add
-con_1:
-
-Add = ""
-For i = 2 To 0 Step -1
-    m = Int(d / (10 ^ i))
-    If i = 2 Then
-        If m <> 0 Then
-            R = W100(m) + " "
-        End If
-    End If
-    If i = 1 Then
-        If m <> 0 Then
-            If d < 20 Then
-                R = W1(d) + " "
-                Result = Result + R
-                GoTo con_2
-            End If
-            R = W10(m) + " "
-        End If
-    End If
-    If i = 0 Then
-        If m <> 0 Then
-            If p = 0 Then
-                R = W1(m) + " "
-            Else
-                R = W1a(m) + " "
-            End If
-        End If
-    End If
-    
-    d = d - (m * (10 ^ i))
-    Result = Result + R
-    R = ""
-Next i
-con_2:
-
-
-If p = 0 Then       ' rub
-    Result = Result + "���. "
-End If
-
-For i = 1 To 0 Step -1
-    m = Int(e / (10 ^ i))
-    Result = Result + Chr$(m + Asc("0"))
-    e = e - (m * (10 ^ i))
-Next i
-
-If p = 0 Then       ' rub
-    Result = Result + " ���."
-Else                ' y.e.
-    Result = Result + "/100 �.�"
-End If
-
-Result(1) = Result(1) + Chr(Asc("A")) - Chr(Asc("a"))
-
-Digit2String = Result
-
-End Function
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Forecast()
-Attribute Forecast.VB_Description = "Macro recorded 06.12.2002 by nick"
-Attribute Forecast.VB_ProcData.VB_Invoke_Func = "f\n14"
-    With Selection
-        .Cells(1, 2).GoalSeek Goal:=1746, ChangingCell:=.Cells(1, 1)
-    End With
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub RandFill()
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ListFunc
->>>>>>
-Attribute VB_Name = "ListFunc"
-Option Explicit
-
-Function getEqClass(r As Range, ClRange As Range) As Integer
-    Dim i As Integer
-    For i = 1 To ClRange.Count
-        If r < ClRange.Cells(i) Then
-            getEqClass = i
-            Exit Function
-        End If
-    Next i
-End Function
-
-Function getClassLetter(Idx As Integer, ClNames As Range) As String
-    getClassLetter = ClNames.Cells(Idx)
-End Function
-
-Function GetEqLetter(r As Range, ClRange As Range, ClNames As Range) As String
-    GetEqLetter = getClassLetter(getEqClass(r, ClRange), ClNames)
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag lengthProject Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    Call CleanUp
-End Sub
-
-Private Sub Workbook_Open()
-    Call CreateFormBar
-    frmFaceID.Show
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-'Global variables hold preious choices
-'for begining and ending FaceID numbers
-Public glbLastFirstID As Long
-Public glbLastLastID As Long
-
-
-Function CBShowButtonFaceIDs(lngIDStart As Long, _
-                             lngIDStop As Long)
-    ' This procedure creates a toolbar with buttons that display the
-    ' images associated with the values starting at lngIDStart and
-    ' ending at lngIDStop.
-    
-    Dim cbrNewToolbar   As CommandBar
-    Dim cmdNewButton    As CommandBarButton
-    Dim intCntr         As Integer
-    
-    ' Delete existing ShowFaceIds toolbar if it exists.
-    On Error Resume Next
-    Application.CommandBars("ShowFaceIds").Delete
-    frmFaceID.MousePointer = fmMousePointerHourGlass
-    ' Create a new toolbar.
-    Set cbrNewToolbar = Application.CommandBars.Add _
-        (Name:="ShowFaceIds", temporary:=True)
-    
-    ' Create a new button with an image matching the FaceId property value
-    ' indicated by intCntr.
-    For intCntr = lngIDStart To lngIDStop
-        Set cmdNewButton = cbrNewToolbar.Controls.Add(Type:=msoControlButton)
-        With cmdNewButton
-            ' Setting the FaceId property value specifies the appearance
-            ' but not the functionality of the button.
-            .FaceId = intCntr
-            .Caption = "FaceId = " & intCntr
-        End With
-    Next intCntr
-    
-    ' Show the images on the toolbar.
-    With cbrNewToolbar
-        .Width = 600
-        .Left = 100
-        .Top = 200
-        .Visible = True
-    End With
-    frmFaceID.MousePointer = fmMousePointerDefault
-End Function
-
-
-
-Public Function Validate()
-Dim lngTempNumber As Long
-
-'Procedure to check data entered by user
-With frmFaceID
-'If the first number requested < last number
-'then reverse them and rationalize
-'display next time form opens
-    If .txtFirstID Or .txtLastID > 0 Then
-        If CLng(.txtFirstID) > CLng(.txtLastID) Then
-           lngTempNumber = .txtFirstID
-           .txtFirstID = .txtLastID
-           .txtLastID = lngTempNumber
-         glbLastFirstID = .txtFirstID
-         glbLastLastID = .txtLastID
-        End If
- 'Only allow 200 FaceIDs per operation
- 'Call procedure to create FaceID values
- 'Take form out of memory
- 
-        If (.txtLastID - .txtFirstID) <= 200 Then
-            Call CBShowButtonFaceIDs(.txtFirstID, .txtLastID)
-            Unload frmFaceID
-        Else
-            MsgBox "Please request less than 200 FaceID's ", , "FaceID Number Finder"
-        End If
-    Else
-            .txtFirstID.SetFocus
-    End If
-End With
-End Function
-
-Public Function CleanUp()
-    On Error Resume Next
-   
-    Application.CommandBars("ShowFaceIds").Delete
-    Application.CommandBars("ShowForm").Delete
-      
-        
-End Function
-
-Public Function CreateFormBar()
-    Dim cmdBar As CommandBar
-    Dim btnForm As CommandBarButton
-'Delete the object if it already exists
-    On Error Resume Next
-    Application.CommandBars("ShowForm").Delete
-'Set the commandbar object variable
-    Set cmdBar = Application.CommandBars.Add
-        cmdBar.Name = "ShowForm"
-'Add a button
-    With cmdBar.Controls
-        
-        Set btnForm = .Add(msoControlButton)
-        
-    End With
-'Set the new button's properties
-    With btnForm
-        .Style = msoButtonIconAndCaption
-        .Caption = "Show FaceId Finder Form"
-        .FaceId = 2104
-        .OnAction = "OpenForm"
-        .TooltipText = "Show FaceID Form"
-    End With
-  ' Made visible in the form terminate event
-
-End Function
-
-Public Function OpenForm()
-'OnAction event procedure of ShowForm toolbar
-    frmFaceID.Show
-End Function
-
-
-<<<<<<
-======================
-frmFaceID
->>>>>>
-Attribute VB_Name = "frmFaceID"
-Attribute VB_Base = "0{5F1D3654-0CF0-11D2-B619-00AA00BBB974}{5F1D3641-0CF0-11D2-B619-00AA00BBB974}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub cmdFaceId_Click()
-  
-  Dim strDefaultStatus As String
- 'Set up global variables with current requested values
-    glbLastFirstID = txtFirstID
-    glbLastLastID = txtLastID
- 'Detect current status bar value
- 'Set status bar message while FaceId's are generated
-    strDefaultStatus = Application.DisplayStatusBar
-    Application.DisplayStatusBar = True
-    Application.StatusBar = "Working on FaceID display please wait"
-    
-'Call validation procedure
-   
-    Call Validate
- 'Put Status bar back as it was
-    Application.DisplayStatusBar = False
-    Application.StatusBar = strDefaultStatus
-End Sub
-
-
-Private Sub txtFirstID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
-   'Test for non numeric entry then cancel or convert to long
-    If IsNumeric(txtFirstID) = False Then
-       txtFirstID = ""
-       Cancel = True
-    Else
-        txtFirstID = CLng(txtFirstID)
-    End If
-    
-End Sub
-
-
-Private Sub txtLastID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
-    'Test for non numeric entry then cancel or convert to long
-    If IsNumeric(txtLastID) = False Then
-       txtLastID = ""
-       Cancel = True
-    Else
-        txtLastID = CLng(txtLastID)
-    End If
-    
-End Sub
-
-Private Sub UserForm_Activate()
- 'Set up form with last requested values
- 'Make toolbar not visible
- On Error Resume Next
-    txtFirstID = glbLastFirstID
-    txtLastID = glbLastLastID
-    Application.CommandBars("ShowForm").Visible = False
-End Sub
-
-
-
-Private Sub UserForm_Terminate()
-    'Show toolbar if form is unloaded in
-    'Validate procedure of if X is clicked
-    Application.CommandBars("ShowForm").Visible = True
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Function GetRegion(idx As Integer) As String
-    GetRegion = Range("LST_REGIONS").Offset(i, 0)
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Workbook_Activate()
-    Worksheets("Home").Select
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("C4:G30").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("D44:H59").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-PPExport
->>>>>>
-Attribute VB_Name = "PPExport"
-Option Explicit
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub ViewReport()
-    Dim ReportDoc As PowerPoint.Presentation
-    Set ReportDoc = GetObject(GetWBPath(ThisWorkbook.FullName) + "report.ppt")
-    ReportDoc.Application.Visible = True
-End Sub
-
-Sub CreateReportSlide(ReportDoc As PowerPoint.Presentation, Title As String)
-    Dim ReportPage As PowerPoint.Slide
-    
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.Count + 1, ppLayoutBlank)
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = Title
-End Sub
-
-Sub CreateReport()
-    Dim ReportApp As PowerPoint.Application
-    Dim ReportDoc As PowerPoint.Presentation
-    
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    Set ReportDoc = ReportApp.Presentations.Add
-    
-    Dim i As Integer
-    For i = 1 To 4
-        ThisWorkbook.Worksheets("Sheet" + Format(i)).ExportCopy
-        CreateReportSlide ReportDoc, "Create slide name #" + Format(i)
-    Next i
-    
-    ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + "report"
-    ReportApp.Quit
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Workbook_Activate()
-    Worksheets("Home").Select
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("C4:G30").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("D44:H59").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-PPExport
->>>>>>
-Attribute VB_Name = "PPExport"
-Option Explicit
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub ViewReport()
-    Dim ReportDoc As PowerPoint.Presentation
-    Set ReportDoc = GetObject(GetWBPath(ThisWorkbook.FullName) + "report.ppt")
-    ReportDoc.Application.Visible = True
-End Sub
-
-Sub CreateReportSlide(ReportDoc As PowerPoint.Presentation, Title As String)
-    Dim ReportPage As PowerPoint.Slide
-    
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.Count + 1, ppLayoutBlank)
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = Title
-End Sub
-
-Sub CreateReport()
-    Dim ReportApp As PowerPoint.Application
-    Dim ReportDoc As PowerPoint.Presentation
-    
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    Set ReportDoc = ReportApp.Presentations.Add
-    
-    Dim i As Integer
-    For i = 1 To 4
-        ThisWorkbook.Worksheets("Sheet" + Format(i)).ExportCopy
-        CreateReportSlide ReportDoc, "Create slide name #" + Format(i)
-    Next i
-    
-    ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + "report"
-    ReportApp.Quit
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'Telfast_marketing'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    Dim res
-    res = MsgBox( _
-        prompt:="�� ������� ��������� ���������? �� ������ ��?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If res <> vbYes Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    
-    Dim NewFileName, DefFileName, WBPath As String
-    NewFileName = MakeNewFileName( _
-                        Worksheets("home").Range("USER_NAME_F"), _
-                        Worksheets("home").Range("USER_NAME_S"), _
-                        Worksheets("data").Range("CITY_TABLES") _
-                        .Offset( _
-                            Worksheets("data").Range("IDX_CITY"), _
-                            (Worksheets("data").Range("IDX_REGION") - 1) * 2 _
-                        ) _
-                    )
-    DefFileName = MakeNewFileName( _
-                        DEF_USER_NAME_F, _
-                        DEF_USER_NAME_S, _
-                        Worksheets("data").Range("CITY_TABLES") _
-                        .Offset(DEF_IDX_CITY, (DEF_IDX_REGION - 1) * 2) _
-                    )
-    WBPath = GetWBPath(ThisWorkbook.FullName)
-    
-    If ThisWorkbook.Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            If NewFileName <> DefFileName Then
-                dlgFname.Caption = PROGRAM_NAME
-                dlgFname.lbFName = NewFileName
-                dlgFname.lbFPath = WBPath
-                dlgFname.Show
-                NewFileName = WBPath & NewFileName
-                ThisWorkbook.SaveAs FileName:=NewFileName
-            Else
-                ThisWorkbook.Save
-            End If
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(HOME_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 1
-    Case INP_TXT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-
-    If is_InputRange(Target) <> INP_NO Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    Dim test As Boolean
-    
-    is_InputRange = INP_NO
-    
-    If r.Column = Range("USER_NAME_F").Column Then
-        test = r.Row = Range("USER_NAME_S").Row _
-                        Or r.Row = Range("USER_NAME_F").Row
-        If test Then
-            is_InputRange = INP_TXT
-        End If
-    Else
-        If r.Column = Range("USER_PLAN").Column Then
-            test = r.Row = Range("USER_PLAN").Row _
-                            Or r.Row = Range("USER_FACT").Row _
-                            Or r.Row = Range("USER_BUDGET").Row _
-                            Or r.Row = Range("USER_SVNORM").Row
-            
-            Dim idx As Integer
-            idx = Worksheets(DATA_SHEET).Range("IDX_PERSONE")
-            
-            If test Then
-                is_InputRange = INP_NUM
-            Else
-                If r.Row = Range("USER_STAF").Row Then
-                    If idx = 1 Then
-                        is_InputRange = INP_NUM
-                    End If
-                End If
-            End If
-        End If
-    End If
-End Function
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC As String = "C9"
-Const INP_APT As String = "C11"
-Const INP_ADV As String = "C13"
-Const INP_ACT As String = "C15"
-Const INP_VIP As String = "C17"
-Const INP_SUM As String = "C19"
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    
-    If is_InputRange(Target) Then
-        GoalSeekNow Range(INP_SUM), Target
-    Else
-        If Target.Row = Range(INP_SUM).Row And Target.Column = Range(INP_SUM).Column Then
-            Dim Addr As String
-            
-            Addr = INP_DOC & "," & INP_APT & "," & INP_ADV & "," & INP_ACT & "," & INP_VIP
-            RangeNormalize Range(Addr), Target
-            
-        End If
-    End If
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.2
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range(INP_DOC).Column _
-                And ( _
-                    r.Row = Range(INP_DOC).Row _
-                    Or r.Row = Range(INP_APT).Row _
-                    Or r.Row = Range(INP_ADV).Row _
-                    Or r.Row = Range(INP_ACT).Row _
-                    Or r.Row = Range(INP_VIP).Row _
-                )
-End Function
-
-
-<<<<<<
-======================
-mHome
->>>>>>
-Attribute VB_Name = "mHome"
-Option Explicit
-
-Sub cboxPersone_Change()
-    With ThisWorkbook.Worksheets(HOME_SHEET)
-        Dim r As Range
-        Range("A1").Select
-        If .Shapes("cboxPersone").ControlFormat.ListIndex = 2 Then
-            .Unprotect
-            .Range("G15") = 1
-            If Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-                .Protect
-            End If
-        End If
-    End With
-End Sub
-
-Sub cboxArea_Change()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    With ThisWorkbook.Worksheets(DATA_SHEET)
-        GroupIdx = .Range("IDX_REGION")
-        .Range("IDX_CITY") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        NewSumRange = .Name & "!" & .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).Address
-    End With
-    With ThisWorkbook.Worksheets(HOME_SHEET)
-        .Shapes("cboxCity").ControlFormat.ListFillRange = NewCbxRange
-        .Unprotect
-        .Range("G10").Formula = "=sum(" & NewSumRange & ")"
-        If Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-            .Protect
-        End If
-    End With
-End Sub
-
-Sub cboxCity_Change()
-    
-End Sub
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-
-Sub btHome_Click()
-    Worksheets(HOME_SHEET).Select
-    Worksheets(DATA_SHEET).Range("CUR_STATE") = 0
-End Sub
-
-Sub bt2Budget_Click()
-    Sheets("budget").Select
-End Sub
-
-
-Sub btBdgtPrev_Click()
-    btHome_Click
-End Sub
-
-Sub btBdgtNext_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Final").Select
-    End If
-End Sub
-
-Sub btDoc_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Doc").Select
-    End If
-End Sub
-
-Sub btDocVisit_Click()
-    Sheets("Doc.Visit").Select
-End Sub
-
-Sub btDocConf_Click()
-    Sheets("Doc.Conf").Select
-End Sub
-
-Sub btApt_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Apt").Select
-    End If
-End Sub
-
-Sub btAptVisit_Click()
-    Sheets("Apt.Visit").Select
-End Sub
-
-
-Sub btAptConf_Click()
-    Sheets("Apt.Conf").Select
-End Sub
-
-Sub btAdv_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Adv").Select
-    End If
-End Sub
-
-Sub btAdvPrev_Click()
-    If check_Adv Then
-        bt2Budget_Click
-    End If
-End Sub
-
-Sub btAct_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Act").Select
-    End If
-End Sub
-
-Sub btCost_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Cost").Select
-    End If
-End Sub
-
-Sub btCostPrev_Click()
-    If check_budget(Range("Cost!C17")) Then
-        Sheets("budget").Select
-    End If
-End Sub
-
-<<<<<<
-======================
-Sheet40
->>>>>>
-Attribute VB_Name = "Sheet40"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.7
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range("C9").Column _
-                    And r.Row = Range("C9").Row
-End Function
-
-
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub test()
-    Dim str As String
-    str = GetWBPath(ThisWorkbook.FullName)
-End Sub
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-Attribute SetDesignFlagOn.VB_ProcData.VB_Invoke_Func = "E\n14"
-    Dim Sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each Sh In Worksheets
-        Sh.Unprotect
-        Sh.Visible = xlSheetVisible
-    Next Sh
-    Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-Attribute SetDesignFlagOff.VB_ProcData.VB_Invoke_Func = " \n14"
-    Application.ScreenUpdating = False
-    Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim Sh As Worksheet
-    For Each Sh In Worksheets
-        If Sh.Name <> "data" Then
-            Sh.Protect
-        Else
-            Sh.Visible = xlSheetVeryHidden
-        End If
-    Next Sh
-    Application.ScreenUpdating = True
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma training"
-Public Const PROGRAM_VERSION As String = "version 1.0"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "N35"
-Public Const CITY_TABLES As String = "N30"
-
-
-Public Const DATA_SHEET As String = "data"
-
-' �������� ����� Home
-Public Const DEF_USER_NAME_F As String = "����"
-Public Const DEF_USER_NAME_S As String = "��������"
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Public Const HOME_SHEET As String = "Home"
-Public Const USER_NAME_F As String = "USER_NAME_F"
-Public Const USER_NAME_S As String = "USER_NAME_S"
-Public Const USER_PLAN As String = "USER_PLAN"
-Public Const USER_BUDGET As String = "USER_BUDGET"
-Public Const USER_FACT As String = "USER_FACT"
-
-' �������� ����� Adv
-Public Const ADV_SHEET As String = "Adv"
-Public Const ADV_SUM_CAP As String = "K9"
-Public Const ADV_SUM_DOC As String = "C17"
-Public Const ADV_SUM_APT As String = "E17"
-Public Const ADV_SUM_CAST As String = "G17"
-Public Const ADV_SUM_DIST As String = "I17"
-
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{81B9D41B-89F6-4B17-9F1D-45017FFC6C8F}{EF972C75-B6C6-407C-BAF6-74472541F2BB}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{0D5199B4-A753-4F74-A564-40388FABC4B0}{19DC56E2-E0F4-44B4-8B23-51B77A2564D5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-Sheet52
->>>>>>
-Attribute VB_Name = "Sheet52"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTDATE_LT As String = "B11"
-Const INPUTDATE_RB As String = "B25"
-Const INPUTTEXT_LT As String = "C11"
-Const INPUTTEXT_RB As String = "C25"
-Const INPUTNUMB_LT As String = "F11"
-Const INPUTNUMB_RB As String = "I25"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("B11").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTDATE_LT), Range(INPUTDATE_RB)) Then
-        is_InputRange = INP_DAT
-    Else
-        If is_InputArea(r, Range(INPUTTEXT_LT), Range(INPUTTEXT_RB)) Then
-            is_InputRange = INP_TXT
-        Else
-            If is_InputArea(r, Range(INPUTNUMB_LT), Range(INPUTNUMB_RB)) Then
-                    is_InputRange = INP_NUM
-            Else
-                is_InputRange = INP_NO
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Function check_Adv() As Boolean
-    Dim b As Boolean
-    b = Abs(Range(ADV_SUM_CAP) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_DOC) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_APT) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_CAST) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_DIST) - 1) < 0.0001 _
-        Or Range("D13") = 0
-    If Not b Then
-        MsgBox "�� ��������� ��������� ������. �������� ����� ������ ���� = 100%"
-    End If
-    check_Adv = b
-End Function
-
-Function check_budget(r As Range) As Boolean
-    Dim f As Double
-    Dim b As Boolean
-    f = r
-    b = Abs(f - 1#) < 0.0001
-    If Not b Then
-        MsgBox "�� ��������� ��������� ������. �������� ����� ������ ���� = 100%"
-    End If
-    check_budget = b
-End Function
-
-Sub RangeNormalize(Src As Range, Dst As Range)
-    Dim f As Double
-    Dim c As Range
-    f = Dst
-    If f <> 0 Then
-        Src.Worksheet.Unprotect
-        For Each c In Src
-            c = c / f
-        Next c
-        If Not Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-            Src.Worksheet.Protect
-        End If
-    Else
-        MsgBox "������� ���� �� ���� �����!"
-    End If
-End Sub
-
-Sub GoalSeekNow(Goal As Range, Target As Range)
-    Dim diff As Double
-    
-    diff = Goal - 1
-    If Abs(diff) > 0.0001 Then
-        If (diff > 0 And diff < Target) Or (diff < 0 And 1 - Target > Abs(diff)) Then
-            Goal.GoalSeek Goal:=1, ChangingCell:=Range(Target.Address)
-        Else
-            MsgBox "���������� �������� �� ��������. �������� ������ ��������!"
-        End If
-    End If
-
-End Sub
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100."
-    End If
-End Sub
-
-Sub Check_Number(Target As Range, Def_Val As Double)
-    Dim test As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                test = True
-            End If
-        End If
-    Next r
-    
-    If test Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!"
-    End If
-    
-End Sub
-
-Function is_InputArea(r As Range, LT As Range, RB As Range) As Boolean
-    is_InputArea = r.Column >= LT.Column _
-                And r.Row >= LT.Row _
-                And r.Column <= RB.Column _
-                And r.Row <= RB.Row
-End Function
-
-<<<<<<
-======================
-Sheet70
->>>>>>
-Attribute VB_Name = "Sheet70"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_NUM_1_LT As String = "E14"
-Const INP_NUM_1_RB As String = "J14"
-Const INP_NUM_2_LT As String = "E16"
-Const INP_NUM_2_RB As String = "J16"
-Const INP_NUM_3_LT As String = "E18"
-Const INP_NUM_3_RB As String = "J18"
-Const INP_NUM_4_LT As String = "E20"
-Const INP_NUM_4_RB As String = "J20"
-Const INP_NUM_5_LT As String = "E22"
-Const INP_NUM_5_RB As String = "J22"
-
-Const INP_DAT_1_LT As String = "B14"
-Const INP_DAT_1_RB As String = "C14"
-Const INP_DAT_2_LT As String = "B16"
-Const INP_DAT_2_RB As String = "C16"
-Const INP_DAT_3_LT As String = "B18"
-Const INP_DAT_3_RB As String = "C18"
-Const INP_DAT_4_LT As String = "B20"
-Const INP_DAT_4_RB As String = "C20"
-Const INP_DAT_5_LT As String = "B22"
-Const INP_DAT_5_RB As String = "C22"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("B14").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) <> INP_NO Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Integer
-    Dim test As Boolean
-    
-    test = is_InputArea(r, Range(INP_NUM_1_LT), Range(INP_NUM_1_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_2_LT), Range(INP_NUM_2_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_3_LT), Range(INP_NUM_3_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_4_LT), Range(INP_NUM_4_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_5_LT), Range(INP_NUM_5_RB))
-    If test Then
-       is_InputRange = INP_NUM
-    Else
-        test = is_InputArea(r, Range(INP_DAT_1_LT), Range(INP_DAT_1_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_2_LT), Range(INP_DAT_2_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_3_LT), Range(INP_DAT_3_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_4_LT), Range(INP_DAT_4_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_5_LT), Range(INP_DAT_5_RB))
-        If test Then
-            is_InputRange = INP_DAT
-        Else
-            is_InputRange = INP_NO
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-Sheet30
->>>>>>
-Attribute VB_Name = "Sheet30"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet41
->>>>>>
-Attribute VB_Name = "Sheet41"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const MEMBERSHIP As String = "D7"
-Const MILEAGE As String = "D9"
-Const INPUTAREA_LT As String = "C17"
-Const INPUTAREA_RB As String = "E24"
-
-Const ChangeCheckFlag As Boolean = False
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C17").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-        Case 1
-            Check_Number Target, 1
-        Case 2
-            Check_Number Target, 15
-        Case 3
-            Check_Number Target, 50
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If r.Column = Range(MEMBERSHIP).Column And r.Row = Range(MEMBERSHIP).Row Then
-        is_InputRange = 1
-    Else
-        If r.Column = Range(MILEAGE).Column And r.Row = Range(MILEAGE).Row Then
-            is_InputRange = 2
-        Else
-            If r.Column >= Range(INPUTAREA_LT).Column _
-                And r.Row >= Range(INPUTAREA_LT).Row _
-                And r.Column <= Range(INPUTAREA_RB).Column _
-                And r.Row <= Range(INPUTAREA_RB).Row Then
-                    is_InputRange = 3
-            Else
-                is_InputRange = 0
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet42
->>>>>>
-Attribute VB_Name = "Sheet42"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTDATE_LT As String = "B11"
-Const INPUTDATE_RB As String = "B25"
-Const INPUTTEXT_LT As String = "C11"
-Const INPUTTEXT_RB As String = "C25"
-Const INPUTNUMB_LT As String = "F11"
-Const INPUTNUMB_RB As String = "I25"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range(INPUTDATE_LT).Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTDATE_LT), Range(INPUTDATE_RB)) Then
-        is_InputRange = INP_DAT
-    Else
-        If is_InputArea(r, Range(INPUTTEXT_LT), Range(INPUTTEXT_RB)) Then
-            is_InputRange = INP_TXT
-        Else
-            If is_InputArea(r, Range(INPUTNUMB_LT), Range(INPUTNUMB_RB)) Then
-                    is_InputRange = INP_NUM
-            Else
-                is_InputRange = INP_NO
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet60
->>>>>>
-Attribute VB_Name = "Sheet60"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC_LT As String = "C10"
-Const INP_DOC_RB As String = "C16"
-Const INP_APT_LT As String = "E10"
-Const INP_APT_RB As String = "E16"
-Const INP_CAST_LT As String = "G10"
-Const INP_CAST_RB As String = "G16"
-Const INP_DIST_LT As String = "I10"
-Const INP_DIST_RB As String = "I16"
-Const CAP_DOC As String = "C9"
-Const CAP_APT As String = "E9"
-Const CAP_CAST As String = "G9"
-Const CAP_DIST As String = "I9"
-
-
-Const INP_NO As Integer = 0
-Const INP_CAP As Integer = 1
-Const INP_DOC As Integer = 2
-Const INP_APT As Integer = 3
-Const INP_CAST As Integer = 4
-Const INP_DIST As Integer = 5
-
-Const INP_SUM_CAP As Integer = 11
-Const INP_SUM_DOC As Integer = 12
-Const INP_SUM_APT As Integer = 13
-Const INP_SUM_CAST As Integer = 14
-Const INP_SUM_DIST As Integer = 15
-
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim Inp As Integer
-    Dim Addr As String
-    Inp = is_InputRange(Target)
-    Select Case is_InputRange(Target)
-        Case INP_NO
-            Cancel = False
-        
-        Case INP_CAP
-            GoalSeekNow Range(ADV_SUM_CAP), Target
-        
-        Case INP_DOC
-            GoalSeekNow Range(ADV_SUM_DOC), Target
-        
-        Case INP_APT
-            GoalSeekNow Range(ADV_SUM_APT), Target
-        
-        Case INP_CAST
-            GoalSeekNow Range(ADV_SUM_CAST), Target
-        
-        Case INP_DIST
-            GoalSeekNow Range(ADV_SUM_DIST), Target
-        
-        Case INP_SUM_CAP
-            Addr = CAP_DOC & "," & CAP_APT & "," & CAP_CAST & "," & CAP_DIST
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_DOC
-            Addr = INP_DOC_LT & ":" & INP_DOC_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_APT
-            Addr = INP_APT_LT & ":" & INP_APT_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_CAST
-            Addr = INP_CAST_LT & ":" & INP_CAST_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_DIST
-            Addr = INP_DIST_LT & ":" & INP_DIST_RB
-            RangeNormalize Range(Addr), Target
-    End Select
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_CAP
-        Check_Percent Target, 0.25
-    Case INP_DOC, INP_APT, INP_CAST, INP_DIST
-        Check_Percent Target, 0.15
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) > 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Integer
-    is_InputRange = INP_NO
-    If r.Row = Range(CAP_DOC).Row Then
-        If r.Column = Range(CAP_DOC).Column _
-                Or r.Column = Range(CAP_APT).Column _
-                Or r.Column = Range(CAP_CAST).Column _
-                Or r.Column = Range(CAP_DIST).Column Then
-            is_InputRange = INP_CAP
-        End If
-        If r.Column = Range(ADV_SUM_CAP).Column Then
-            is_InputRange = INP_SUM_CAP
-        End If
-    Else
-        If is_InputArea(r, Range(INP_DOC_LT), Range(INP_DOC_RB)) Then
-            is_InputRange = INP_DOC
-        Else
-            If is_InputArea(r, Range(INP_APT_LT), Range(INP_APT_RB)) Then
-                is_InputRange = INP_APT
-            Else
-                If is_InputArea(r, Range(INP_CAST_LT), Range(INP_CAST_RB)) Then
-                    is_InputRange = INP_CAST
-                Else
-                    If is_InputArea(r, Range(INP_DIST_LT), Range(INP_DIST_RB)) Then
-                        is_InputRange = INP_DIST
-                    Else
-                        If r.Row = Range(ADV_SUM_DOC).Row Then
-                            If r.Column = Range(ADV_SUM_DOC).Column Then
-                                is_InputRange = INP_SUM_DOC
-                            End If
-                            If r.Column = Range(ADV_SUM_APT).Column Then
-                                is_InputRange = INP_SUM_APT
-                            End If
-                            If r.Column = Range(ADV_SUM_APT).Column Then
-                                is_InputRange = INP_SUM_APT
-                            End If
-                            If r.Column = Range(ADV_SUM_CAST).Column Then
-                                is_InputRange = INP_SUM_CAST
-                            End If
-                            If r.Column = Range(ADV_SUM_DIST).Column Then
-                                is_InputRange = INP_SUM_DIST
-                            End If
-                        End If
-                    End If
-                End If
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet50
->>>>>>
-Attribute VB_Name = "Sheet50"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.7
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range("C9").Column _
-                    And r.Row = Range("C9").Row
-End Function
-
-
-<<<<<<
-======================
-Sheet51
->>>>>>
-Attribute VB_Name = "Sheet51"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTAREA_LT As String = "C17"
-Const INPUTAREA_RB As String = "E20"
-
-Const ChangeCheckFlag As Boolean = False
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C17").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) <> 0 Then
-        Check_Number Target, 50
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTAREA_LT), Range(INPUTAREA_RB)) Then
-        is_InputRange = 3
-    Else
-        is_InputRange = 0
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet80
->>>>>>
-Attribute VB_Name = "Sheet80"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC As String = "C9"
-Const INP_APT As String = "C11"
-Const INP_CUST As String = "C13"
-Const INP_DIST As String = "C15"
-Const INP_SUM As String = "C17"
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    
-    If is_InputRange(Target) Then
-        GoalSeekNow Range(INP_SUM), Target
-    Else
-        If Target.Row = Range(INP_SUM).Row And Target.Column = Range(INP_SUM).Column Then
-            Dim Addr As String
-            
-            Addr = INP_DOC & "," & INP_APT & "," & INP_CUST & "," & INP_DIST
-            RangeNormalize Range(Addr), Target
-            
-        End If
-    End If
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.25
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range(INP_DOC).Column _
-                And ( _
-                    r.Row = Range(INP_DOC).Row _
-                    Or r.Row = Range(INP_APT).Row _
-                    Or r.Row = Range(INP_CUST).Row _
-                    Or r.Row = Range(INP_DIST).Row _
-                )
-End Function
-
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-'                With .Controls
-'                    With .Add(msoControlButton)
-'                        .Caption = "&Contents"
-'                        .Style = msoButtonIconAndCaption
-'                        .FaceId = 49
-'                        .OnAction = "cmHelpContents"
-'                    End With
-'                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Telfast.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-    ThisWorkbook.Worksheets("home").Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-    Else
-        cmSetStandaloneMode
-    End If
-    ThisWorkbook.Worksheets("home").Select
-End Sub
-
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.Count > 1 Then
-        wbname = Wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            Wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Telfast bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(HOME_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(HOME_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{6B54EA33-E5D1-44C0-BC3C-E5960329B246}{639FA6FC-FBAC-44B4-ACC5-7DAF95DA47F4}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    
-    dlgPrint.cbMainReport = True
-    dlgPrint.cbMainBudget = False
-    dlgPrint.cbSrcData = False
-    dlgPrint.cbAllSheets = False
-    
-    dlgPrint.Show
-    
-    If dlgPrint.Tag = vbCancel Then
-        Exit Sub
-    End If
-    
-    Dim PrnIdx As Integer
-    
-    With dlgPrint
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("home", "budget", "Final")
-    Case 1111
-        plist = Array("home", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("home")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-dlgFname
->>>>>>
-Attribute VB_Name = "dlgFname"
-Attribute VB_Base = "0{AB4D9ABD-F40E-4C39-8FE4-0625E69E5365}{2CC3E532-33AC-44D8-9195-34917AF21E8C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btOK_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Macro1()
-Attribute Macro1.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro1.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro1 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    Charts.Add
-    ActiveChart.ChartType = xlBubble
-    ActiveChart.SetSourceData Source:=Sheets("file1").Range("H2:J11"), PlotBy:= _
-        xlColumns
-    ActiveChart.Location Where:=xlLocationAsObject, Name:="file1"
-    With ActiveChart
-        .HasTitle = True
-        .ChartTitle.Characters.Text = "�������"
-        .Axes(xlCategory, xlPrimary).HasTitle = True
-        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "���� ��������"
-        .Axes(xlValue, xlPrimary).HasTitle = True
-        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "���������� �������"
-    End With
-    With ActiveChart.Axes(xlCategory)
-        .HasMajorGridlines = True
-        .HasMinorGridlines = False
-    End With
-    With ActiveChart.Axes(xlValue)
-        .HasMajorGridlines = True
-        .HasMinorGridlines = False
-    End With
-    ActiveChart.HasLegend = False
-    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
-    ActiveChart.SeriesCollection(1).Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(9).DataLabel.Select
-    Selection.Characters.Text = "8379 �1"
-    Selection.AutoScaleFont = False
-    With Selection.Characters(Start:=1, Length:=7).Font
-        .Name = "Arial"
-        .FontStyle = "�������"
-        .Size = 10
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveChart.Axes(xlValue).MajorGridlines.Select
-End Sub
-Sub Macro2()
-Attribute Macro2.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro2.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro2 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    Application.CutCopyMode = False
-    With ActiveChart.ChartGroups(1)
-        .VaryByCategories = True
-        .ShowNegativeBubbles = False
-        .SizeRepresents = xlSizeIsArea
-        .BubbleScale = 100
-    End With
-End Sub
-Sub Macro3()
-Attribute Macro3.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro3.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro3 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(6).DataLabel.Select
-    ActiveChart.Axes(xlValue).MajorGridlines.Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(6).DataLabel.Select
-    Selection.Characters.Text = "9847 �2"
-    Selection.AutoScaleFont = False
-    With Selection.Characters(Start:=1, Length:=7).Font
-        .Name = "Arial"
-        .FontStyle = "�������"
-        .Size = 12
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveChart.PlotArea.Select
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-    xlRestoreView
-End Sub
-
-Sub xlRestoreView()
-    Application.CommandBars("Standard").Visible = True
-    Application.CommandBars("Formatting").Visible = True
-    Application.DisplayFormulaBar = True
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'ClexanePM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    Application.ScreenUpdating = True
-'    CheckUser
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).update_history
-    Application.Calculate
-
-End Sub
-
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "QTR_SEL"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Worksheets(REP_QTR_SHEET).Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .setEnt_date (ent_date)
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).getEnt_date()
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public ppReport As New cPPReport
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[PM]"
-Public Const PROGRAM_VERSION As String = "Clexane[PM] ver 1.1"
-Public Const PROGRAM_FILENAME As String = "clexane-pm"
-Public Const PROGRAM_BACKUPNAME As String = "pm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "pm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "rm-ex*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-Public Const CHART_DEF_TITLE As String = "* * *"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20031207
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O41"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-Public Const PRJ_QTR_SHEET As String = "PRJ_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Function time_correct(end_date As Long, ByVal theDate As Date) As Boolean
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-    If end_date = NO_ESTIMATION_DATE Then
-        time_correct = True
-        Exit Function
-    End If
-    
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    
-    time_correct = CurDate <= end_date
-    
-End Function
-
-Sub EnableRun(end_date As Long)
-    If Not time_correct(end_date, Now) Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub t()
-    EnableRun ESTIMATION_DATE
-End Sub
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Sub OpenPPT()
-    ppReport.ReportView
-End Sub
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    SelectLPU_BDGT lpu_id, ent_date
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .setEnt_date (ent_date)
-            .Range("lpu_id") = lpu_id
-            .Range("REP_ID") = rep_id
-            .Range("RM_ID") = rm_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("RM_ID") = rm_id
-        .Range("REP_ID") = rep_id
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.Name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{32FB0F3D-6884-41DC-99DB-E2C55B2257C4}{DED79A66-DA60-4CCC-9003-082480235D55}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{0DC9E035-CE0A-49FF-85A2-A4EC5FF8FE96}{D54DDC8A-1EE2-4BB3-8B94-343B521AF098}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S15"
-
-Sub PrintCopy()
-    Range("B1:K21").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), Range("RM_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    objLPU = Get_LPU_Record(id, Range("RM_ID"))
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.Name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BFB4547C-96A7-4739-AA0A-CEF1E35E2BDC}{C3D618A3-9410-4BC7-9D93-3B049D361132}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.Name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-    sh.Range("ret_addr") = ""
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{9AAD262F-A6C4-4912-9C58-D7A2071181B8}{9470F4EB-DA9F-4584-9159-D09319548D21}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{A8FBEE9C-DE59-49DE-971D-07BC9C0E9BD2}{C712732B-D8E4-4C2D-8E78-AC90968E0CD7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hw_reset()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        MsgBox "2"
-        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-'    Dim cREGMAN As tREGMAN
-'    Dim idx As Integer
-'    Dim dlg_ui As UserInfo
-'
-'    Set dlg_ui = New UserInfo
-'
-'    cREGMAN = Get_REGMAN_Record()
-'
-'    With ThisWorkbook.Worksheets(REGS_SHEET)
-'        .Range("IDX_REGION") = cREGMAN.Region
-'        .Range("IDX_CITY") = cREGMAN.City
-'    End With
-'
-'    With dlg_ui
-'        .cbRegion = cREGMAN.Region
-'        .cbCity = cREGMAN.City
-'        .tbFName = cREGMAN.FirstName
-'        .tbLName = cREGMAN.LastName
-'    End With
-'
-'    dlg_ui.Show
-'    Worksheets(REGS_SHEET).Calculate
-'
-'    If dlg_ui.Tag = vbOK Then
-'        With cREGMAN
-'            .Region = dlg_ui.cbRegion.Value
-'            .City = dlg_ui.cbCity.Value
-'            .FirstName = dlg_ui.tbFName.Value
-'            .LastName = dlg_ui.tbLName.Value
-'        End With
-'        Set_REGMAN_Record cREGMAN
-'    Else
-'        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-'    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    rm_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String, rm_id As Long) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String, rm_id As Long) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .rm_id = rm_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    rm_id As Long
-    Name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long, rm_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long, rm_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.Name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.Name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.rm_id = dbRecordset("rm_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id " & _
-    "AND lpu.rep_id=" & rep_id & " AND lpu.rm_id=lpu_budget.rm_id AND lpu.rm_id=" & rm_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds, lpu.rm_id AS rm_id " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .Name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cdbRM
->>>>>>
-Attribute VB_Name = "cdbRM"
-Option Explicit
-
-Public Type tRMID_COMMON
-    rm As tREGMAN
-    rgcd_count As Integer
-    rgcd() As tREGION
-End Type
-
-Function Get_RM_CommonList_by_QTR(ByRef rmcd() As tRMID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_RM_CommonList_by_QTR = dbGet_RM_CommonList_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_RM_CommonList_by_QTR(dbConnection As Object, ByRef rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    ' �������� ������ RM-��
-    Dim count As Integer
-    count = db_get_All_RM_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    Dim i As Integer
-    For i = 1 To count
-        rmcd(i).rgcd_count = 1
-        ReDim rmcd(i).rgcd(1 To 1)
-        getREGION_by_QTR ent_date, rmcd(i).rgcd(1), rmcd(i).rm.rm_id
-    Next i
-    dbGet_RM_CommonList_by_QTR = count
-End Function
-
-Function db_get_All_RM_by_QTR(dbConnection As Object, rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    
-    Dim count_sql As String
-    Dim get_sql As String
-    Dim rs As Object
-    Dim RM_Count As Integer
-        
-    count_sql = "SELECT COUNT(*) AS RM_TOTAL FROM reg_man"
-    get_sql = "SELECT * FROM reg_man"
-    Set rs = CreateObject("ADODB.Recordset")
-    rs.Open count_sql, dbConnection
-    
-    If Not rs.BOF Then
-        RM_Count = rs("RM_TOTAL")
-    End If
-    
-    rs.Close
-    
-     db_get_All_RM_by_QTR = RM_Count
-    
-    If RM_Count > 0 Then
-        'we have records
-        ReDim rmcd(1 To RM_Count)
-        Dim index As Long
-        index = 1
-        rs.Open get_sql, dbConnection
-        
-        If Not rs.BOF Then
-             Do While Not rs.EOF
-                 Dim tmp_rmcd As tRMID_COMMON
-                 With tmp_rmcd
-                    .rgcd_count = 0
-                    .rm.City = rs("city")
-                    .rm.FirstName = rs("firstname")
-                    .rm.LastName = rs("lastname")
-                    .rm.rm_id = rs("mgr_id")
-                    .rm.Region = rs("region")
-                 End With
-                 
-                 rmcd(index) = tmp_rmcd
-                 index = index + 1
-                 rs.MoveNext
-             Loop
-        End If
-    End If
-    
-End Function
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-           With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub CreateExtCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom extendet commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Add New Slide"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 280
-                .OnAction = "cmAddSlide"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        Application.ScreenUpdating = False
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        Application.ScreenUpdating = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmNewReport()
-    ppReport.CreateReport
-    MsgBox "����� ����� ������", vbInformation + vbOKOnly, PROGRAM_NAME
-    CreateExtCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmOpenReport()
-    Dim fileToOpen
-    Dim s As String
-    fileToOpen = Application _
-        .GetOpenFileName("Report Files (*.ppt), *.ppt", title:="Report OPen", MultiSelect:=False)
-    If fileToOpen <> False Then
-        s = fileToOpen
-        ppReport.OpenReport s
-        CreateExtCommandBar theApp:=ThisWorkbook.Application
-    End If
-End Sub
-
-Sub cmCloseReport()
-    On Error Resume Next
-    ppReport.SaveReport
-    CreateCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmAddSlide()
-    ThisWorkbook.ActiveSheet.PrintCopy
-    ppReport.InsertSlide
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("PRJ_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Unprotect
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("LPU_LIST")
-        s = .Range("C4") & " " & .Range("C3") & ", " & .Range("G4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-End Sub
-
-Sub btLPU_DEL_IT()
-'    Dim cLPU As tLPU
-'    Dim ent_date As String
-'    Dim delete_all As Integer
-'    Dim dlg_del As dlg_LPU_delete
-'
-'    With Worksheets("LPU_LIST")
-'        ent_date = .Range("ent_date")
-'        cLPU.id = .getCurrentLPU_ID()
-'    End With
-'
-'    If cLPU.id = 0 Then
-'        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-'        Exit Sub
-'    End If
-'    cLPU = Get_LPU_Record(cLPU.id)
-'
-'    Set dlg_del = New dlg_LPU_delete
-'    With dlg_del
-'        .chbDeleteQTR.Value = True
-'        .chbDeleteAll.Value = False
-'        .lComment = ent_date & ": �������� ��� '" _
-'        & cLPU.Name & "', �������������� �� ������:" _
-'        & cLPU.address & " �� ���������."
-'        .Show
-'    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    rm_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-        .rm_id = rm_id
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.rm_id = dbRecordset("rm_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id, rm_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    Dim rep_sql As String
-    Dim rm_sql As String
-    
-    rep_sql = ""
-    rm_sql = ""
-    
-    If rep_id <> 0 Then
-        rep_sql = " AND rep_id=" & rep_id
-    End If
-    
-    If rm_id <> 0 Then
-        rm_sql = " AND rm_id=" & rm_id
-    End If
-    
-    
-        getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql
-        getAll_QTR_SQL = "SELECT * FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql & " ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{92648543-CB84-4B6B-BEB3-539AE7EF9D84}{7E20E3E3-027A-483B-A14D-AA9EA5398ACC}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "��������� �����: " & Range("title")
-    Range("view_key") = False
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(%): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{067FED69-B41E-427D-AF59-5798B8E2E73A}{4C13CAB1-FDCC-4708-89EB-E92EDC125712}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id, objQTR.rm_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "���� ������: " & Range("title")
-    
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� ������: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "������� ���: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{9C81F4D2-4ECF-46F5-999B-9801D572A12F}{B382508B-7F3D-4747-8407-0F75F6F265F5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{EA8CE4CE-AC2E-45BC-BAF8-1429E6242097}{575F0762-04F4-4F86-B98A-8E87E3424B0D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(rep_id As Long, rm_id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, rep_id As Long, rm_id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT * FROM " & _
-          "rep WHERE rep_id=" & rep_id & " AND rm_id=" & rm_id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.rm_id = dbRecordset("rm_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    If rm_id <> 0 Then
-        Where = Where & " AND rep.rm_id=" & rm_id
-    End If
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record(Range("RM_ID"))
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN, Range("RM_ID"))
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record(rm_id As Long) As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSet_REGMAN_Record dbConnection, cREGMAN
-'    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object, rm_id As Long) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    objREGMAN.rm_id = rm_id
-    sql = "SELECT * FROM " & _
-          "reg_man WHERE mgr_id=" & rm_id
-          
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM reg_man"
-'    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREGMAN.FirstName & "', " & _
-'    "'" & objREGMAN.LastName & "', " & _
-'    objREGMAN.Region & ", " & _
-'    objREGMAN.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    Name As String
-End Type
-
-Public Type tDBTABLE
-    Name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).Name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).Name = "entry_date"
-    tables(1).field(2).Name = "bdgt_NMG"
-    tables(1).field(3).Name = "bdgt_NFG"
-    tables(1).field(4).Name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).Name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).Name = "entry_date"
-    tables(2).field(2).Name = "operations_per_quarter"
-    tables(2).field(3).Name = "risk_percent"
-    tables(2).field(4).Name = "patients_with_risk_ON"
-    tables(2).field(5).Name = "patients_ambulator"
-    tables(2).field(6).Name = "patients_ambulator_nmg"
-    tables(2).field(7).Name = "patients_ambulator_clexan"
-    tables(2).field(8).Name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).Name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).Name = "patients_stationar_nmg"
-    tables(2).field(11).Name = "patients_stationar_clexan"
-    tables(2).field(12).Name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).Name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).Name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).Name = "entry_date"
-    tables(3).field(2).Name = "patients_with_geparins"
-    tables(3).field(3).Name = "patients_per_quarter"
-    tables(3).field(4).Name = "patients_stationar_nmg"
-    tables(3).field(5).Name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).Name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).Name = "entry_date"
-    tables(4).field(2).Name = "patients_with_geparins"
-    tables(4).field(3).Name = "patients_per_quarter"
-    tables(4).field(4).Name = "patients_stationar_nmg"
-    tables(4).field(5).Name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).Name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).Name = "entry_date"
-    tables(5).field(2).Name = "patients_per_quarter"
-    tables(5).field(3).Name = "risk_percent"
-    tables(5).field(4).Name = "patients_with_risk_ON"
-    tables(5).field(5).Name = "patients_ambulator"
-    tables(5).field(6).Name = "patients_ambulator_nmg"
-    tables(5).field(7).Name = "patients_ambulator_clexan"
-    tables(5).field(8).Name = "patients_stationar_nmg"
-    tables(5).field(9).Name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).Name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).Name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).Name) = getRS(tables(tbl_idx).field(fld_idx).Name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 10)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    tables_to_clear(9) = "quarter_rm"
-    tables_to_clear(10) = "reg_man"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-cdbPRJ
->>>>>>
-Attribute VB_Name = "cdbPRJ"
-Option Explicit
-
-Type tPROJECT
-    total_SALE  As Long ' ����� ����� ������
-    total_BDGT  As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU   As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_RM    As Long ' ����� �����
-    total_BEDS  As Long ' ����� ����� ����
-    total_HIR   As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER   As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS   As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN   As Long '  ���� ������ ��������
-    objRGN() As tREGION
-End Type
-
-Function GetPRJ_COMM_DATA(ByRef prj_data As tPROJECT) As Integer
-    Dim i As Integer
-    i = GetRGN_COMM_DATA(prj_data.objRGN, 0)
-    GetPRJ_COMM_DATA = i
-    If i > 0 Then
-        With prj_data
-            .sale_PLAN = 0
-            .total_ACS = 0
-            .total_BDGT = 0
-            .total_BDGT_NMG = 0
-            .total_BEDS = 0
-            .total_HIR = 0
-            .total_LPU = 0
-            .total_REP = 0
-            .total_RM = 0
-            .total_SALE = 0
-            .total_TER = 0
-            For i = 1 To UBound(prj_data.objRGN)
-                
-            Next i
-        End With
-    End If
-
-End Function
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-        .setEnt_date (getEnt_date())
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("RM_ID") = rm_id
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    Dim rm_struc As tREGMAN
-    
-    i = Range("RM_ID")
-    rm_struc = Get_REGMAN_Record(i)
-    
-    Range("C4") = rm_struc.LastName
-    Range("C5") = rm_struc.FirstName
-
-    Range("G5") = GetRegionName(rm_struc.Region)
-    
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date, Range("RM_ID"))
-
-    
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_LIST")
-        s = .Range("C5") & " " & .Range("C4") & ", " & .Range("G5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("REP_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date, rm_id)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id, allREPID(i).rm_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    rm_id As Long
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION, rm_id As Long) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date, rm_id)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_REP_count As Integer
-            reg_data(i).rm_id = rm_id
-            reg_data(i).ent_date = q_date(i)
-            current_REP_count = getREGION_by_QTR(q_date(i), reg_data(i), rm_id)
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-' if rm_id = 0 then gets all records
-Function getAllQTRNames(ByRef qtr_lst() As String, rm_id As Long) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    
-    If rm_id <> 0 Then
-        sql = sql & " WHERE rm_id=" & rm_id
-    End If
-    
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION, rm_id As Long) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tQTR_COMMON
-    rep_count = Get_QTR_CommonList_by_REP(reps, ent_date, 0, rm_id)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .c_bdgt_NFG + .c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtr.sale_PLAN
-                treg.total_SALE = treg.total_SALE + .c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .c_pat_HIR
-                treg.total_TER = treg.total_TER + .c_pat_TER
-                treg.total_ACS = treg.total_ACS + .c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .i_lcd
-                treg.total_BEDS = treg.total_BEDS + .c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-'            def_dir = GetWBPath(ThisWorkbook.FullName)
-'            If GetImportDirectory(def_dir, flist) Then
-'                Dim db_list() As String
-'                i = GetDBList(flist, db_list)
-'                If i > 0 Then
-'                    ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-'                End If
-'            End If
-'            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Range("ret_addr") = "RM_QTR"
-            Worksheets("REP_LIST").setEnt_date (Worksheets(RM_QTR_SHEET).getEnt_date())
-            Worksheets("REP_LIST").Range("RM_ID") = Worksheets(RM_QTR_SHEET).Range("RM_ID")
-            Worksheets("REP_LIST").Range("VIEW_ONLY") = True
-
-            Worksheets("REP_LIST").Select
-        Case 3
-            MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub btRM_QTR_RET_IT()
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cPPReport
->>>>>>
-Attribute VB_Name = "cPPReport"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Const PPR_NON As Integer = 0
-Const PPR_NEW As Integer = 1
-Const PPR_OLD As Integer = 2
-
-Dim ReportApp As PowerPoint.Application
-Dim ReportDoc As PowerPoint.Presentation
-Dim ReportState As Integer
-Dim PowerPointPath As String
-
-Private Sub Class_Initialize()
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    PowerPointPath = ReportApp.Path & "\PowerPNT.EXE"
-    ReportState = PPR_NON
-End Sub
-
-Sub OpenReport(FileName As String)
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = GetObject(FileName)
-    ReportState = PPR_OLD
-End Sub
-
-Sub CreateReport()
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = ReportApp.Presentations.Add
-    ReportState = PPR_NEW
-End Sub
-
-Sub SaveReport()
-    Select Case ReportState
-        Case PPR_NEW
-            ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME
-        Case PPR_OLD
-            ReportDoc.Save
-    End Select
-    ReportState = PPR_NON
-End Sub
-
-Sub ReportView()
-    Dim CmdName As String
-    CmdName = GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME + ".PPT"
-    CmdName = PowerPointPath & " " & CmdName
-    Shell CmdName, 1
-End Sub
-
-Sub InsertSlide()
-    Dim ReportPage As PowerPoint.Slide
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.count + 1, ppLayoutBlank)
-    
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = "Slide #" & Format(ReportDoc.Slides.count)
-End Sub
-
-
-Private Sub Class_Terminate()
-    SaveReport
-    ReportApp.Quit
-End Sub
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{36355920-F7A4-44A8-96EF-5D79CF26137D}{F852BDF2-AB3E-468E-89DF-EC5DC0C7C88B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-rmImport
->>>>>>
-Attribute VB_Name = "rmImport"
-Option Explicit
-
-Public Type dbDESCRIPTION
-    Name As String
-    Fields() As String
-End Type
-
-Sub ImportFromRegionalManagers(rm_files() As String, fm_file As String)
-    Dim db(9) As dbDESCRIPTION
-    
-    '''''data
-    db(1).Name = "rep"
-    
-    db(2).Name = "lpu"
-    db(3).Name = "lpu_acs"
-    db(4).Name = "lpu_budget"
-    db(5).Name = "lpu_hir"
-    db(6).Name = "lpu_im"
-    db(7).Name = "lpu_ter"
-    db(8).Name = "quarter"
-    db(9).Name = "quarter_rm"
-    
-    ReDim db(1).Fields(5)
-    With db(1)
-        .Fields(1) = "rep_id"
-        .Fields(2) = "firstname"
-        .Fields(3) = "lastname"
-        .Fields(4) = "region"
-        .Fields(5) = "city"
-    End With
-    
-    ReDim db(2).Fields(5)
-    With db(2)
-        .Fields(1) = "id"
-        .Fields(2) = "rep_id"
-        .Fields(3) = "name"
-        .Fields(4) = "address"
-        .Fields(5) = "beds"
-    End With
-    
-    ReDim db(3).Fields(7)
-    With db(3)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(4).Fields(6)
-    With db(4)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "bdgt_NMG"
-        .Fields(5) = "bdgt_NFG"
-        .Fields(6) = "sale_PLAN"
-    End With
-    
-    ReDim db(5).Fields(15)
-    With db(5)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "operations_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_ambulator_clexan_40mg"
-        .Fields(11) = "patients_ambulator_clexan_20mg"
-        .Fields(12) = "patients_stationar_nmg"
-        .Fields(13) = "patients_stationar_clexan"
-        .Fields(14) = "patients_stationar_clexan_40mg"
-        .Fields(15) = "patients_stationar_clexan_20mg"
-    End With
-    
-    
-    ReDim db(6).Fields(7)
-    With db(6)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(7).Fields(11)
-    With db(7)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_stationar_nmg"
-        .Fields(11) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(8).Fields(9)
-    With db(8)
-        .Fields(1) = "ID"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "rep_id"
-        .Fields(4) = "sale_plan"
-        .Fields(5) = "ClxnH20mg"
-        .Fields(6) = "ClxnH40mg"
-        .Fields(7) = "ClxnT40mg"
-        .Fields(8) = "ClxnC_IM"
-        .Fields(9) = "ClxnC_ACS"
-    End With
-    
-    ReDim db(9).Fields(3)
-    With db(9)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "sale_plan"
-    End With
-    
-    Dim rm_idx As Integer
-    Dim to_db As Object
-    'back uo
-    Merge_BackUp_All_Data
-    
-    'clean up
-    Merge_Clear_All_Data fm_file
-    
-    Set to_db = dbGetConnection(fm_file)
-    
-    For rm_idx = 1 To UBound(rm_files)
-        Dim from_db As Object
-        
-        Set from_db = dbGetConnection(rm_files(rm_idx))
-        
-        Dim new_rm_id As Long
-        new_rm_id = dbMergeRM(from_db, to_db)
-
-        Dim i As Integer
-
-        For i = 1 To UBound(db)
-            Dim get_sql As String
-            Dim getRS As Object
-            Dim insRS As Object
-            Dim field_idx As Integer
-                        
-            get_sql = "SELECT * FROM " & db(i).Name
-            Set getRS = CreateObject("ADODB.Recordset")
-            Set insRS = CreateObject("ADODB.Recordset")
-            insRS.Open db(i).Name, to_db, 2, 2
-
-            getRS.Open get_sql, from_db
-            
-            If Not getRS.BOF Then
-                Do While Not getRS.EOF
-                    insRS.addnew
-                    Dim fld_name As String
-                    
-                    For field_idx = 1 To UBound(db(i).Fields)
-                        fld_name = db(i).Fields(field_idx)
-                        insRS(fld_name) = getRS(fld_name)
-                    Next field_idx
-                    
-                    insRS("rm_id") = new_rm_id
-                    insRS.Update
-                    getRS.MoveNext
-                Loop
-            
-            Else
-                'empty table
-                ' do nothing
-            End If
-            
-            
-        Next i
-        
-        dbCloseOpenedConnection from_db
-    Next rm_idx
-    
-    dbCloseOpenedConnection to_db
-End Sub
-
-Function dbMergeRM(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM reg_man"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about Regional Manager! This database cannot be merged!!!"
-            dbMergeRM = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "reg_man", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    dbMergeRM = insertRecordset("mgr_id")
-    
-End Function
-
-Sub cmDataImport()
-    Dim def_dir As String
-    Dim flist() As String
-    Dim i As Integer
-
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        
-        If i > 0 Then
-            ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-        End If
-    End If
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-
-<<<<<<
-======================
-PRJ_QTR
->>>>>>
-Attribute VB_Name = "PRJ_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CPRJ_QT As Integer = 0
-Const CPRJ_ID As Integer = 1
-Const CPRJ_PLN As Integer = 2
-Const CPRJ_FCT As Integer = 3
-Const CPRJ_BDG As Integer = 4
-Const CPRJ_CNT As Integer = 5
-Const CPRJ_BEDS As Integer = 6
-Const CPRJ_HIR As Integer = 7
-Const CPRJ_TER As Integer = 8
-Const CPRJ_CRD As Integer = 9
-Const CPRJ_CLXN_BDG As Integer = 10
-Const CPRJ_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("PRJ_QTR")
-        s = "��� �������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tREGION
-    Dim i As Long
-    Dim r As Range
-
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objQTR(), 0)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CPRJ_QT) = objQTR(i).ent_date
-            r.Offset(i - 1, CPRJ_ID) = ""
-            r.Offset(i - 1, CPRJ_PLN) = objQTR(i).sale_PLAN
-            r.Offset(i - 1, CPRJ_FCT) = objQTR(i).total_SALE
-            r.Offset(i - 1, CPRJ_BDG) = objQTR(i).total_BDGT
-            r.Offset(i - 1, CPRJ_CNT) = objQTR(i).total_LPU
-            r.Offset(i - 1, CPRJ_BEDS) = objQTR(i).total_REP
-            r.Offset(i - 1, CPRJ_HIR) = objQTR(i).total_HIR
-            r.Offset(i - 1, CPRJ_TER) = objQTR(i).total_TER
-            r.Offset(i - 1, CPRJ_CRD) = objQTR(i).total_ACS
-            If objQTR(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_BDG) = objQTR(i).total_SALE / objQTR(i).total_BDGT
-            End If
-            If objQTR(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_NMG) = objQTR(i).total_SALE / objQTR(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CPRJ_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_CLXN_NMG + 1)
-        End If
-    Next i
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Public Sub cbxPRJ_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_PRJ
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_PRJ
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_PRJ
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = PRJ_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CPRJ_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "PRJ_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btPRJ_QTR_Do_IT ' old btRM_OTR_DO_IT
-End Sub
-
-<<<<<<
-======================
-RM_LIST
->>>>>>
-Attribute VB_Name = "RM_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentRM_ID() As Long
-    Dim r As Range
-
-    With Worksheets("RM_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CRM_ID)
-    End With
-
-    getCurrentRM_ID = r
-End Function
-
-Public Sub RM_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("PM_CHR_IDX")
-        Case 1
-            Rm_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rm_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rm_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-
-        Case 4
-            Rm_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectRM_QTR(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "RM_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("RM_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Public Sub SelectREP_LIST(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "REP_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .setEnt_date (getEnt_date())
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateRMList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Sub UpdateRMList()
-    Dim rmcd() As tRMID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_RM_CommonList_by_QTR(rmcd(), ent_date)
-
-    With ThisWorkbook.Worksheets("RM_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rmcd)
-            r.Offset(i - 1, CRM_NAME) = GetRegionName(rmcd(i).rm.Region)
-            r.Offset(i - 1, CRM_ID) = rmcd(i).rm.rm_id
-            r.Offset(i - 1, CRM_BEDS) = rmcd(i).rgcd(1).total_BEDS
-            r.Offset(i - 1, CRM_BDGT) = rmcd(i).rgcd(1).total_BDGT
-            r.Offset(i - 1, CRM_NMG) = rmcd(i).rgcd(1).total_BDGT_NMG
-            r.Offset(i - 1, CRM_HIR) = rmcd(i).rgcd(1).total_HIR
-            r.Offset(i - 1, CRM_TER) = rmcd(i).rgcd(1).total_TER
-            r.Offset(i - 1, CRM_CAR) = rmcd(i).rgcd(1).total_ACS
-            r.Offset(i - 1, CRM_FACT) = rmcd(i).rgcd(1).total_SALE
-            r.Offset(i - 1, CRM_PLAN) = rmcd(i).rgcd(1).sale_PLAN
-            
-            With rmcd(i).rgcd(1)
-                r.Offset(i - 1, CRM_PAT_LPU) = .total_HIR + .total_TER + .total_ACS
-            End With
-            
-            r.Offset(i - 1, CRM_BDGT_1) = rmcd(i).rgcd(1).total_BDGT
-            If rmcd(i).rgcd(1).total_BDGT > 0 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = rmcd(i).rgcd(1).total_SALE / rmcd(i).rgcd(1).total_BDGT
-            End If
-            If r.Offset(i - 1, CRM_BDGT_1 + 1) > 1 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CRM_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CRM_AREA).row, CRM_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CRM_AREA).Column
-
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CRM_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CRM_NAME
-        Range("JUMP") = ""
-    Else
-        btRM_LIST_DO_IT
-    End If
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-<<<<<<
-======================
-mPRJ_QTR
->>>>>>
-Attribute VB_Name = "mPRJ_QTR"
-Sub btPRJ_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("PRJ_ACTION")
-    ent_date = Worksheets(PRJ_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            cmDataImport
-        Case 2
-            Worksheets("RM_LIST").setEnt_date (Worksheets("PRJ_QTR").getEnt_date())
-            Worksheets("RM_LIST").Range("ret_addr") = "PRJ_QTR"
-            Worksheets("RM_LIST").Select
-        Case 3
-            cmNewReport
-    End Select
-    Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-End Sub
-
-
-<<<<<<
-======================
-mRM_LIST
->>>>>>
-Attribute VB_Name = "mRM_LIST"
-Option Explicit
-
-Public Const CRM_AREA As String = "B12"
-Public Const CRM_NAME As Integer = 0
-Public Const CRM_NAME1 As Integer = 1
-Public Const CRM_NAME2 As Integer = 2
-Public Const CRM_ID As Integer = 3
-Public Const CRM_BEDS As Integer = 4
-Public Const CRM_BDGT As Integer = 5
-Public Const CRM_NMG As Integer = 6
-Public Const CRM_HIR As Integer = 7
-Public Const CRM_TER As Integer = 8
-Public Const CRM_CAR As Integer = 9
-Public Const CRM_FACT As Integer = 10
-Public Const CRM_PLAN As Integer = 11
-Public Const CRM_PAT_LPU As Integer = 16
-Public Const CRM_BDGT_1 As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(CRM As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_LIST")
-        s = "�������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub Rm_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub Rm_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CRM_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub btRM_LIST_RET_IT()
-    With Worksheets("RM_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "PRJ_QTR"
-    End With
-    ThisWorkbook.Worksheets("PRJ_QTR").Activate
-End Sub
-
-
-Sub btRM_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rm_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("RM_LIST_ACTION")
-    With Worksheets("RM_LIST")
-        rm_id = .getCurrentRM_ID()
-        
-        Select Case i
-            Case 1:
-                .SelectRM_QTR rm_id
-            Case 2:
-                .SelectREP_LIST rm_id
-            End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mImport2
->>>>>>
-Attribute VB_Name = "mImport2"
-Option Explicit
-
-Sub FOpen()
-    Dim flist As String
-    Dim fileToOpen, s
-    flist = ""
-    fileToOpen = Application _
-        .GetOpenFileName("Data Files (*.mdb), mr*.mdb", Title:="������ ������", MultiSelect:=True)
-    If fileToOpen <> False Then
-        For Each s In fileToOpen
-            flist = flist & s & "; "
-        Next s
-        MsgBox "Open " & flist
-    End If
-End Sub
-
-Sub t2()
-Dim d As ImprtDB
-Set d = New ImprtDB
-d.Show
-
-End Sub
-
-<<<<<<
-======================
-ImprtDB
->>>>>>
-Attribute VB_Name = "ImprtDB"
-Attribute VB_Base = "0{67FA6A28-8370-4981-8F01-1A9079245761}{ECFCB43F-B241-4CD9-9CB3-2A981933173D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-  "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-  lStructSize As Long
-  hWndOwner As Long
-  hInstance As Long
-  lpstrFilter As String
-  lpstrCustomFilter As String
-  nMaxCustFilter As Long
-  nFilterIndex As Long
-  lpstrFile As String
-  nMaxFile As Long
-  lpstrFileTitle As String
-  nMaxFileTitle As Long
-  lpstrInitialDir As String
-  lpstrTitle As String
-  flags As Long
-  nFileOffset As Integer
-  nFileExtension As Integer
-  lpstrDefExt As String
-  lCustData As Long
-  lpfnHook As Long
-  lpTemplateName As String
-End Type
-
-Private Sub Command1_Click()
-  Dim OpenFile As OPENFILENAME
-  Dim lReturn As Long
-  Dim sFilter As String
-  OpenFile.lStructSize = Len(OpenFile)
-'         OpenFile.hwndOwner = Form1.hWnd
-'         OpenFile.hInstance = App.hInstance
-  sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-  OpenFile.lpstrFilter = sFilter
-  OpenFile.nFilterIndex = 1
-  OpenFile.lpstrFile = String(257, 0)
-  OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-  OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-  OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-' OpenFile.lpstrInitialDir = "C:\"
-  OpenFile.lpstrTitle = "������ ������"
-  OpenFile.flags = OFN_HIDEREADONLY + OFN_ALLOWMULTISELECT + OFN_EXPLORER
-  lReturn = GetOpenFileName(OpenFile)
-  If lReturn = 0 Then
-     MsgBox "The User pressed the Cancel Button"
-  Else
-     MsgBox "The user Chose " & Trim(OpenFile.lpstrFile)
-  End If
-End Sub
-
-<<<<<<
-Project Name : 'ClexaneRM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).ClearRMName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "version 1.3"
-Public Const PROGRAM_FILENAME As String = "clexane-rm"
-Public Const PROGRAM_BACKUPNAME As String = "rm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "rm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "mr-ex-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{F2A5159C-AEB6-4066-B85F-339184DAFECD}{712D78F6-CCB6-499E-9674-B992A7482317}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{5D2CB2D2-3E5E-4B6E-9E0C-2EEBA5E10E17}{C891C133-B6B4-43D3-B411-B4A821905C23}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Boolean
-        Dim sum As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BB60E38F-A4AB-4AB4-91D0-40AA798D9F5C}{BE9A54D9-F093-4755-9E17-0B47BB5E2546}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{2C69E842-8DA9-4240-A0A8-F6B0141DC246}{75AAB28C-ADCF-4D1B-9D5A-AF89E80A810C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{BA873669-5C2D-400A-8A8B-572ACD8CCE4C}{D11400A0-9912-4240-A78C-44C33731216A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSet_REGMAN_Record
-    With Worksheets("RM_QTR")
-        .ClearRMName
-        .Range("REP_QTR_INPUT_DATA").ClearContents ' ��� �� ������, �������� ���������
-'        .Range("A1").Select
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-    
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-
-
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Sub ReSetREPRecord()
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbReSetREPRecord dbConnection
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-'Public Sub dbReSetREPRecord(dbConnection As Object)
-'
-'    Dim DeleteSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-       End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmImport()
-    Worksheets(RM_QTR_SHEET).Select
-    ImportData
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("RM_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    End If
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{3EA3C15A-5493-445F-9858-2F241E7D6CEA}{849C1FE1-631A-485D-BE54-A7B73124582C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{B85FF7F1-50C0-4433-BC6F-8A0F2C9BDDDA}{EC2D2B9E-9ED2-4005-A1E9-EF0626D3B7E7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    
-    Unprotect
-    
-    On Error Resume Next
-    
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{EC96F2D1-337D-47DF-B0F1-A6DF3F8CD5CC}{7EB42A63-CBFC-45B0-AE4D-C3E3D8FE7420}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{7B669454-C2AA-4FDF-8311-7ADEDDEF3FF3}{D07A0A02-4923-46C8-8EE8-62769243087D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetLastQTR_fromDB & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRMName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-End Sub
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSet_REGMAN_Record()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSet_REGMAN_Record dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-Public Sub dbReSet_REGMAN_Record(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-End Sub
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� �������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{D5892870-2C88-40C8-A817-AC9B1CF37C2C}{9853EBEA-4E48-41F9-89C0-6F753EB6A0C2}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            ImportData
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub ImportData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        If i > 0 Then
-            Merge_BackUp_All_Data
-            MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-        End If
-    End If
-    Worksheets(RM_QTR_SHEET).update_history
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-Project Name : 'ClexaneMR'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).ClearRepName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(REP_QTR_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-Const CQTR_PAT_ALL As Integer = 16
-Const CQTR_BDGT_ALL As Integer = 17
-
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRepName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-    Range("H5") = ""
-End Sub
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREP
-    
-    cRep = GetREPRecord
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-    
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    i = GetAll_QTR_Records(objQTR, "%")
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList(qcd)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_plan
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_BBL_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-
-Private Sub Worksheet_Activate()
-  
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-    
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CRow_Width Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-    
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub DO_New_qtr()
-    Dim res As Variant
-    Dim objQTR As tQTR
-    Dim s As String
-    s = GetLastQtr
-    objQTR.entry_date = GetNextQTR(s)
-    
-    If objQTR.entry_date = "" Then
-        Exit Sub
-    End If
-    
-    DO_Price_qtr objQTR.entry_date
-
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        Dim qtr As tQTR
-        Dim res As Integer
-        
-        qtr = Get_QTR_Record(ent_date)
-        
-        If qtr.id = 0 Then
-            qtr.entry_date = ent_date
-    
-            With Worksheets(VAR_SHEET)
-                qtr.ClxnH20mg = .Range("ClxnH20mg")
-                qtr.ClxnH40mg = .Range("ClxnH40mg")
-                qtr.ClxnT40mg = .Range("ClxnT40mg")
-                qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-                qtr.ClxnC_IM = .Range("ClxnC_IM")
-            End With
-        End If
-        
-        Dim dlg_nq As dlg_nextQTR
-        Set dlg_nq = New dlg_nextQTR
-        
-        With dlg_nq
-            .tb_qtr_name = qtr.entry_date
-            .tb_bdgt_avts = qtr.sale_plan
-            .tb_qtr_name = qtr.entry_date
-            .tb_ClxnH20mg = qtr.ClxnH20mg
-            .tb_ClxnH40mg = qtr.ClxnH40mg
-            .tb_ClxnT40mg = qtr.ClxnT40mg
-            .tb_ClxnC_ACS = qtr.ClxnC_ACS
-            .tb_ClxnC_IM = qtr.ClxnC_IM
-        End With
-        
-        dlg_nq.Show
-        res = dlg_nq.Tag
-        
-        If res = vbOK Then
-            With dlg_nq
-                If Not IsNumeric(.tb_bdgt_avts) Then
-                    MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                Else
-                    If .tb_bdgt_avts = 0 Then
-                        MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                        Exit Sub
-                    End If
-                End If
-                Dim bool As Boolean
-                bool = IsNumeric(.tb_ClxnH20mg) _
-                    And IsNumeric(.tb_ClxnH40mg) _
-                    And IsNumeric(.tb_ClxnT40mg) _
-                    And IsNumeric(.tb_ClxnC_ACS) _
-                    And IsNumeric(.tb_ClxnC_IM)
-                If Not bool Then
-                    MsgBox "������� ��������� �����", vbOK, PROGRAM_NAME
-                    Exit Sub
-                End If
-                qtr.sale_plan = .tb_bdgt_avts
-                qtr.entry_date = .tb_qtr_name
-                qtr.ClxnH20mg = .tb_ClxnH20mg
-                qtr.ClxnH40mg = .tb_ClxnH40mg
-                qtr.ClxnT40mg = .tb_ClxnT40mg
-                qtr.ClxnC_ACS = .tb_ClxnC_ACS
-                qtr.ClxnC_IM = .tb_ClxnC_IM
-            End With
-            Insert_QTR_Record qtr
-        End If
-    End If
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = False
-            .Range("ent_date") = ent_date
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        Dim i As Integer
-        i = MsgBox("������� ������ �� ������ [" & ent_date & "]?", vbDefaultButton2 + vbOKCancel, PROGRAM_NAME)
-        If i = vbOK Then
-            Dim objQTR As tQTR
-            If ent_date <> "" Then
-                objQTR.entry_date = ent_date
-                objQTR = Get_QTR_Record(ent_date)
-                Delete_QTR_Record objQTR
-                Worksheets(TITLE_SHEET).Select
-                Worksheets(REP_QTR_SHEET).Select
-            End If
-        End If
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            DO_New_qtr
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            dbExport
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    End Select
-    If idx <> 2 Then
-        With ThisWorkbook
-            .Worksheets(TITLE_SHEET).Select
-            .Worksheets(REP_QTR_SHEET).Select
-        End With
-    End If
-End Sub
-
-Sub Delete_qtr()
-    Dim ent_date As String
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    DO_Delete_qtr ent_date
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[MR]"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-    
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-    
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-        
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-                   
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-       
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CINP_WIDTH Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-    
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-        
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    lpu_id = r
-    
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-    
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-    
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-            
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-        
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-        
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-        
-        Case Else
-            Range("JUMP") = ""
-    End Select
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-    
-    is_input_range = INPUT_NO
-    
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-    
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREP
-    
-    ' ent_date = "%" ' % - all records
-    ent_date = getEnt_date
-    
-    objQTR = Get_QTR_Record(ent_date)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-     
-    ' ������� ���
-    Range("C3:C4").ClearContents
-    cRep = GetREPRecord
-    
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_plan
-    
-
-    
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-        
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-            
-         
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_plan
-            
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-            
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{566B33D6-957A-43E4-8444-D8EA3889700C}{42EE65B8-F8C6-4F95-9F52-7738BF6FCEAD}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-    
-        Dim objHir As tHIRURGIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.Count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-        
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-    
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-            Application.ScreenUpdating = False
-            
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-            
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{EBA94131-180E-4709-A2A3-B60D48987620}{47A860A1-BF92-4EBB-A333-AB7E83FAB868}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_plan = Round(Range("F13").Value, 0)
-            
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_plan
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_plan <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("��������� ������� ��������?", vbYesNo, PROGRAM_NAME) Then
-                    Insert_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-    
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_plan
-    
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    objQTR = Get_QTR_Record(ent_date)
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-    
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-        
-        SetupData cLPU
-        
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case INPUT_CHECK
-            
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{E3F10C5A-A4B4-42FF-A2C9-6F8198210A07}{563D0F3D-F79D-48F1-AFE4-A2136809B982}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{137EDDE5-3DB4-4BAD-A245-324DC31ABB36}{3BD7159A-BF6C-403F-B3DF-4834FA9E4D92}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{8EB80D4C-3476-421A-A370-6332A07DE509}{A7542905-C9F8-4F39-AD67-B62A88F8F4E6}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREP
->>>>>>
-Attribute VB_Name = "mREP"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSetREPRecord
-    With Worksheets("REP_QTR")
-        .ClearRepName
-        .Range("REP_QTR_INPUT_DATA").ClearContents
-        .Range("QTR_SEL") = ""
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-        Worksheets("REP_QTR").Range("QTR_SEL") = ""
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cUser As tREP
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cUser = GetREPRecord()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cUser.Region
-        .Range("IDX_CITY") = cUser.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cUser.Region
-        .cbCity = cUser.City
-        .tbFName = cUser.FirstName
-        .tbLName = cUser.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cUser
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        SetREPRecord cUser
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_plan As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim SQL As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_plan = 0
-    End With
-        
-    
-    SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_plan = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_plan = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_plan
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_plan & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPU(allLPU() As tLPU) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPU = dbGetAllLPU(dbConnection, allLPU)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPUbyQTR(allLPU() As tLPU, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPUbyQTR = dbGetAllLPUbyQTR(dbConnection, allLPU, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objLPU.id = 0 then insert else update
-Sub Insert_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    If objLPU.id = 0 Then
-        dbInsert_LPU_Record dbConnection, objLPU
-    Else
-        dbUpdate_LPU_Record dbConnection, objLPU
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub Delete_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDelete_LPU_Record dbConnection, objLPU
-    dbCloseConnection dbConnection
-End Sub
-
-Sub Delete_LPU_RecordQTR(ByRef objLPU As tLPU, ent_date As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-    dbCloseConnection dbConnection
-    
-End Sub
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim SQL As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    SQL = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Sub dbInsert_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-  
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu", dbConnection, 2, 2
-    dbRecordset.addnew
-    dbRecordset("name") = objLPU.name
-    dbRecordset("address") = objLPU.address
-    dbRecordset("rep_id") = objLPU.rep_id
-    dbRecordset("beds") = objLPU.beds
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objLPU.id = dbRecordset("id")
-  
-End Sub
-
-Sub dbUpdate_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu SET " & _
-    "name='" & objLPU.name & "'," & _
-    "address='" & objLPU.address & "'," & _
-    "beds=" & objLPU.beds & "," & _
-    "rep_id=" & objLPU.rep_id& & _
-    " WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-
-Function dbGetAllLPU(dbConnection As Object, allLPU() As tLPU) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu"
-    getAll_LPU_SQL = "SELECT * FROM lpu"
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPU = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAllLPUbyQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim where As String
-    where = "WHERE lpu_budget.entry_date like '" & ent_date & "'"
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget " & where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & where & " AND lpu.id=lpu_budget.lpu_id"
-    
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPUbyQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Sub dbDelete_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu " & _
-    "WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Hir_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Ter_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_ACS_RecordsByLPU_ID dbConnection, objLPU.id
-    
-End Sub
-
-Sub dbDelete_LPU_RecordQTR(dbConnection As Object, ByRef objLPU As tLPU, ent_date As String)
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-End Sub
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-Option Explicit
-
-Public Type tREP
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetREPRecord() As tREP
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetREPRecord = dbGetREPRecord(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub SetREPRecord(cUser As tREP)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSetREPRecord dbConnection, cUser
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSetREPRecord()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSetREPRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGetREPRecord(dbConnection As Object) As tREP
-    
-    Dim SQL As String
-    Dim objREP As tREP
-    
-    objREP.FirstName = ""
-    objREP.LastName = ""
-    objREP.Region = 0
-    objREP.City = 0
-    SQL = "SELECT firstname, lastname, region, city FROM " & _
-          "rep"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREP.FirstName = dbRecordset("firstname")
-        objREP.LastName = dbRecordset("lastname")
-        objREP.Region = dbRecordset("region")
-        objREP.City = dbRecordset("city")
-        
-    End If
-    
-    dbGetREPRecord = objREP
-        
-End Function
-
-Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREP.FirstName & "', " & _
-    "'" & objREP.LastName & "', " & _
-    objREP.Region & ", " & _
-    objREP.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-End Sub
-
-Public Sub dbReSetREPRecord(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("REP_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-'                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = Double2Str(.risk_percent, 3)
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub test()
-    Dim s As String
-    Dim d As Single
-    d = 1235.6789
-    s = Format(d, "####0,00")
-    MsgBox s
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    Dim del_request As Integer
-    Dim allLPU() As tLPU
-    Dim lpu_count As Integer
-    Dim i As Integer
-    Dim tmp_LPU_List As Range
-    Dim tmp_LPU_List_Addr As String
-    Dim r_end As Range
-    Dim dlg As Dlg_lpu_card
-    
-    Set dlg = New Dlg_lpu_card
-    
-    lpu_count = GetAllLPU(allLPU)
-    With Worksheets(VAR_SHEET)
-        Set tmp_LPU_List = .Range("tmp_LPU_List")
-        Set r_end = .Range(tmp_LPU_List, tmp_LPU_List.End(xlDown))
-        Set r_end = .Range(r_end, r_end.End(xlToRight))
-        .Range(tmp_LPU_List, r_end).ClearContents
-    End With
-        
-    If lpu_count <> 0 Then
-        dlg.cbxLPU_List_Enable.Enabled = True
-        For i = 1 To UBound(allLPU)
-            tmp_LPU_List.Cells(i, 1) = allLPU(i).name
-            tmp_LPU_List.Cells(i, 2) = allLPU(i).address
-            tmp_LPU_List.Cells(i, 3) = allLPU(i).beds
-            tmp_LPU_List.Cells(i, 4) = allLPU(i).id
-        Next i
-    Else
-        dlg.cbxLPU_List_Enable.Enabled = False
-    End If
-    
-    tmp_LPU_List_Addr = Worksheets(VAR_SHEET).name & "!" & _
-            Worksheets(VAR_SHEET).Range(tmp_LPU_List, tmp_LPU_List.End(xlDown)).address
-
-    With dlg
-        .cbLPU_List.RowSource = tmp_LPU_List_Addr
-        .cbLPU_List.ListIndex = 0
-        .cbxLPU_List_Enable = False
-        .cbLPU_List.Enabled = False
-        If cLPU.id <> 0 Then
-            .cbxLPU_List_Enable.Enabled = False
-        Else
-            If lpu_count <> 0 Then
-                .cbxLPU_List_Enable.Enabled = True
-            Else
-                .cbxLPU_List_Enable.Enabled = False
-            End If
-        End If
-        .tb_lpu_name.Text = cLPU.name
-        .tb_lpu_address.Text = cLPU.address
-        .tbBedsCount = cLPU.beds
-
-        .Tag = vbCancel
-    End With
-    
-    dlg.Show
-    
-    If Not IsNumeric(dlg.Tag) Then
-        Exit Sub
-    End If
-    
-    If dlg.Tag = vbOK Then
-        Dim n As Variant
-        Dim test As Integer
-        test = 0
-        n = dlg.tbBedsCount.Value
-        If Not IsNumeric(n) Then
-            test = 1
-        Else
-            If n = 0 Then
-                test = 1
-            End If
-        End If
-        If test = 0 Then
-            
-            cLPU.name = dlg.tb_lpu_name.Text
-            cLPU.address = dlg.tb_lpu_address.Text
-            cLPU.beds = dlg.tbBedsCount.Value
-                                    
-            If cLPU.name = "" Or cLPU.address = "" Then
-                test = 2
-            End If
-        End If
-        Select Case test
-            Case 0
-                If dlg.cbxLPU_List_Enable.Value = True Then
-                    cLPU.id = tmp_LPU_List.Cells(dlg.cbLPU_List.ListIndex + 1, 4)
-                End If
-                Insert_LPU_Record cLPU
-                ' ��������� ������� ������ ��� ��� � ��������
-                Dim bdgt As tBUDGET
-                bdgt = Get_BDGT_Record(cLPU.id, ent_date)
-                ' ������ ���: ������� ������ ������ � lpu_budget
-                If bdgt.id = 0 Then
-                    bdgt.lpu_id = cLPU.id
-                    bdgt.entry_date = ent_date
-                    Insert_BDGT_Record bdgt
-                End If
-            Case 1
-                MsgBox "������� ��������� ���������� ������ ����� ��� 1!", vbOKOnly, PROGRAM_NAME
-            Case 2
-                MsgBox "������������ � ����� ��� �� ������ ���� �������!", vbOKOnly, PROGRAM_NAME
-        End Select
-    End If
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-    
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-    
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-    
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & "."
-        .Show
-        
-        If .Tag = vbOK Then
-            If .chbDeleteAll.Value Then
-                delete_all = _
-                    MsgBox("��� ������ �� ��� � ������ '" & cLPU.name & _
-                    "' ����� ������� ��������.", vbOK, PROGRAM_NAME)
-                If delete_all = vbOK Then
-                    Delete_LPU_Record cLPU
-                End If
-            Else
-                Delete_LPU_RecordQTR cLPU, ent_date
-            End If
-        End If
-    End With
-    
-    With ThisWorkbook
-        .Worksheets(TITLE_SHEET).Select
-        .Worksheets("LPU_LIST").Select
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Activate
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-        
-    
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id <> 0 And i = 1 Then
-            lpu_id = 0
-        End If
-        If lpu_id = 0 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1, 6
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                If lpu_id <> 0 Then
-                    .SelectLPU_BDGT lpu_id, ent_date
-                    .Range("JUMP") = "LPU_BDGT"
-                End If
-            Case 3
-                If lpu_id <> 0 Then
-                    .SelectLPU_HIR lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_HIR"
-                End If
-            Case 4
-                If lpu_id <> 0 Then
-                    .SelectLPU_TER lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_TER"
-                End If
-            Case 5
-                If lpu_id <> 0 Then
-                    .SelectLPU_C_ACS lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_C_ACS"
-                End If
-        End Select
-    End With
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_plan As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    Else
-        getLast_QTR_SQL = ""
-    End If
-    
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Sub Insert_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTR.id <> 0 Then
-        dbUpdate_QTR_Record dbConnection, objQTR
-    Else
-        dbInsert_QTR_Record dbConnection, objQTR
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTR_Record(ent_date As String) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, ent_date)
-    If i <> 0 Then
-        Get_QTR_Record = allQTR(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records(ByRef All_QTR() As tQTR, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTR_Records = dbGetAll_QTR_Records(dbConnection, All_QTR, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTR_Record dbConnection, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTR.ID <> 0 then updatre else insert
-Sub dbInsert_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTR
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_plan
-        dbRecordset("rep_id") = .rep_id
-        dbRecordset("ClxnH20mg") = .ClxnH20mg
-        dbRecordset("ClxnH40mg") = .ClxnH40mg
-        dbRecordset("ClxnT40mg") = .ClxnT40mg
-        dbRecordset("ClxnC_IM") = .ClxnC_IM
-        dbRecordset("ClxnC_ACS") = .ClxnC_ACS
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTR.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim Update_SQL As String
-    
-    With objQTR
-        Update_SQL = "UPDATE quarter SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rep_id=" & .rep_id & "," & _
-            "sale_plan=" & .sale_plan & "," & _
-            "ClxnH20mg=" & .ClxnH20mg & "," & _
-            "ClxnH40mg=" & .ClxnH40mg & "," & _
-            "ClxnT40mg=" & .ClxnT40mg & "," & _
-            "ClxnC_IM=" & .ClxnC_IM & "," & _
-            "ClxnC_ACS=" & .ClxnC_ACS & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTR_Records(dbConnection As Object, All_QTR() As tQTR, ent_date As String) As Integer
-    
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter WHERE entry_date like '" & ent_date & "'"
-    getAll_QTR_SQL = "SELECT * FROM quarter WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTR_Records = QTR_Count
-    
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim All_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_plan = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 All_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter " & _
-    "WHERE id=" & objQTR.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Hir_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Ter_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_ACS_RecordsByQTR dbConnection, objQTR.entry_date
-       
-End Sub
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList(ByRef qcd() As tQTR_COMMON) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList = dbGet_QTR_CommonList(dbConnection, qcd)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList(dbConnection As Object, ByRef qcd() As tQTR_COMMON) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, "%")
-    dbGet_QTR_CommonList = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_plan
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    On Error GoTo l_exit
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-l_exit:
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-        .EditDirectlyInCell = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{2FC04B4C-EB99-433E-ACDB-A920D02B9B5B}{777B85CC-ADE3-4188-94C8-9E07DA8B5076}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    On Error GoTo ExitLabel
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.Count
-                On Error Resume Next
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{3F7D7D75-90F6-4829-9E24-CA5391BB2A03}{A1A0F296-0D28-4123-8E38-82FA6EE6F2EF}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAllLPUbyQTR(dbConnection, allLPU, objQTR.entry_date)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-   
-    Unprotect
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-        
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{91AE5FA0-01C7-4C10-9E5F-D1D2DDF29401}{5726592A-BC0A-4E79-A963-35D354045716}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{FB055133-927F-41FF-BC90-442833A40591}{11BCAB43-1EDD-440B-AB0E-20CD6E42E11A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tID_REP
-    id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Public Type tID_REP_COMMON
-    id_rep As tID_REP
-    i_qtr As Long
-    qtrs As tQTR_COMMON
-End Type
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim last_qtr As String
-    
-    On Error GoTo ErrHandler
-    
-    last_qtr = GetLastQTR_fromDB
-    If last_qtr = "" Then
-        MsgBox "��� ������� � ���� ������. ������� ����������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & last_qtr & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub t()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Save
-End Sub
-
-Private Sub Workbook_Open()
-    FindRestoreData
-End Sub
-
-Sub FindRestoreData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim dbname As String
-    Dim caption As String
-    caption = PROGRAM_NAME + " " + PROGRAM_VERSION
-    If MsgBox("�������������� ������. ����������?", vbYesNo, caption) = vbYes Then
-        def_dir = "C:\CLEXANE"
-        If GetDBName(def_dir, dbname) Then
-            HWReset dbname
-            MsgBox "������ � ����� " + dbname + " ������������� :)", vbOKOnly, caption
-        Else
-            MsgBox "����� ��� ���������"
-        End If
-    End If
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mDataBase
->>>>>>
-Attribute VB_Name = "mDataBase"
-Option Explicit
-
-Sub dbOpenConnection(dbConnection As Object, dbname As String)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = dbname
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Sub HWReset(dbname As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection, dbname
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-mGetDBName
->>>>>>
-Attribute VB_Name = "mGetDBName"
-Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetDBName(DB_dir As String, dbname As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "clexane*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "����������� ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetDBName = False
-        dbname = ""
-    Else
-        GetDBName = True
-        Dim flist() As String
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        dbname = flist(0)
-    End If
-End Function
-
-
-<<<<<<
-Project Name : 'ClexaneRM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).ClearRMName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "version 1.3"
-Public Const PROGRAM_FILENAME As String = "clexane-rm"
-Public Const PROGRAM_BACKUPNAME As String = "rm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "rm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "mr-ex-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{F2A5159C-AEB6-4066-B85F-339184DAFECD}{712D78F6-CCB6-499E-9674-B992A7482317}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{5D2CB2D2-3E5E-4B6E-9E0C-2EEBA5E10E17}{C891C133-B6B4-43D3-B411-B4A821905C23}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Boolean
-        Dim sum As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BB60E38F-A4AB-4AB4-91D0-40AA798D9F5C}{BE9A54D9-F093-4755-9E17-0B47BB5E2546}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{2C69E842-8DA9-4240-A0A8-F6B0141DC246}{75AAB28C-ADCF-4D1B-9D5A-AF89E80A810C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{BA873669-5C2D-400A-8A8B-572ACD8CCE4C}{D11400A0-9912-4240-A78C-44C33731216A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSet_REGMAN_Record
-    With Worksheets("RM_QTR")
-        .ClearRMName
-        .Range("REP_QTR_INPUT_DATA").ClearContents ' ��� �� ������, �������� ���������
-'        .Range("A1").Select
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-    
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-
-
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Sub ReSetREPRecord()
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbReSetREPRecord dbConnection
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-'Public Sub dbReSetREPRecord(dbConnection As Object)
-'
-'    Dim DeleteSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-       End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmImport()
-    Worksheets(RM_QTR_SHEET).Select
-    ImportData
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("RM_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    End If
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{3EA3C15A-5493-445F-9858-2F241E7D6CEA}{849C1FE1-631A-485D-BE54-A7B73124582C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{B85FF7F1-50C0-4433-BC6F-8A0F2C9BDDDA}{EC2D2B9E-9ED2-4005-A1E9-EF0626D3B7E7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    
-    Unprotect
-    
-    On Error Resume Next
-    
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{EC96F2D1-337D-47DF-B0F1-A6DF3F8CD5CC}{7EB42A63-CBFC-45B0-AE4D-C3E3D8FE7420}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{7B669454-C2AA-4FDF-8311-7ADEDDEF3FF3}{D07A0A02-4923-46C8-8EE8-62769243087D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetLastQTR_fromDB & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRMName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-End Sub
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSet_REGMAN_Record()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSet_REGMAN_Record dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-Public Sub dbReSet_REGMAN_Record(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-End Sub
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� �������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{D5892870-2C88-40C8-A817-AC9B1CF37C2C}{9853EBEA-4E48-41F9-89C0-6F753EB6A0C2}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            ImportData
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub ImportData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        If i > 0 Then
-            Merge_BackUp_All_Data
-            MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-        End If
-    End If
-    Worksheets(RM_QTR_SHEET).update_history
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-Project Name : 'ClexanePM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    Application.ScreenUpdating = True
-'    CheckUser
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).update_history
-    Application.Calculate
-
-End Sub
-
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "QTR_SEL"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Worksheets(REP_QTR_SHEET).Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .setEnt_date (ent_date)
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).getEnt_date()
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public ppReport As New cPPReport
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[PM]"
-Public Const PROGRAM_VERSION As String = "Clexane[PM] ver 1.1"
-Public Const PROGRAM_FILENAME As String = "clexane-pm"
-Public Const PROGRAM_BACKUPNAME As String = "pm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "pm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "rm-ex*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-Public Const CHART_DEF_TITLE As String = "* * *"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20031207
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O41"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-Public Const PRJ_QTR_SHEET As String = "PRJ_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Function time_correct(end_date As Long, ByVal theDate As Date) As Boolean
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-    If end_date = NO_ESTIMATION_DATE Then
-        time_correct = True
-        Exit Function
-    End If
-    
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    
-    time_correct = CurDate <= end_date
-    
-End Function
-
-Sub EnableRun(end_date As Long)
-    If Not time_correct(end_date, Now) Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub t()
-    EnableRun ESTIMATION_DATE
-End Sub
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Sub OpenPPT()
-    ppReport.ReportView
-End Sub
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    SelectLPU_BDGT lpu_id, ent_date
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .setEnt_date (ent_date)
-            .Range("lpu_id") = lpu_id
-            .Range("REP_ID") = rep_id
-            .Range("RM_ID") = rm_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("RM_ID") = rm_id
-        .Range("REP_ID") = rep_id
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.Name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{32FB0F3D-6884-41DC-99DB-E2C55B2257C4}{DED79A66-DA60-4CCC-9003-082480235D55}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{0DC9E035-CE0A-49FF-85A2-A4EC5FF8FE96}{D54DDC8A-1EE2-4BB3-8B94-343B521AF098}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S15"
-
-Sub PrintCopy()
-    Range("B1:K21").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), Range("RM_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    objLPU = Get_LPU_Record(id, Range("RM_ID"))
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.Name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BFB4547C-96A7-4739-AA0A-CEF1E35E2BDC}{C3D618A3-9410-4BC7-9D93-3B049D361132}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.Name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-    sh.Range("ret_addr") = ""
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{9AAD262F-A6C4-4912-9C58-D7A2071181B8}{9470F4EB-DA9F-4584-9159-D09319548D21}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{A8FBEE9C-DE59-49DE-971D-07BC9C0E9BD2}{C712732B-D8E4-4C2D-8E78-AC90968E0CD7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hw_reset()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        MsgBox "2"
-        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-'    Dim cREGMAN As tREGMAN
-'    Dim idx As Integer
-'    Dim dlg_ui As UserInfo
-'
-'    Set dlg_ui = New UserInfo
-'
-'    cREGMAN = Get_REGMAN_Record()
-'
-'    With ThisWorkbook.Worksheets(REGS_SHEET)
-'        .Range("IDX_REGION") = cREGMAN.Region
-'        .Range("IDX_CITY") = cREGMAN.City
-'    End With
-'
-'    With dlg_ui
-'        .cbRegion = cREGMAN.Region
-'        .cbCity = cREGMAN.City
-'        .tbFName = cREGMAN.FirstName
-'        .tbLName = cREGMAN.LastName
-'    End With
-'
-'    dlg_ui.Show
-'    Worksheets(REGS_SHEET).Calculate
-'
-'    If dlg_ui.Tag = vbOK Then
-'        With cREGMAN
-'            .Region = dlg_ui.cbRegion.Value
-'            .City = dlg_ui.cbCity.Value
-'            .FirstName = dlg_ui.tbFName.Value
-'            .LastName = dlg_ui.tbLName.Value
-'        End With
-'        Set_REGMAN_Record cREGMAN
-'    Else
-'        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-'    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    rm_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String, rm_id As Long) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String, rm_id As Long) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .rm_id = rm_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    rm_id As Long
-    Name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long, rm_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long, rm_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.Name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.Name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.rm_id = dbRecordset("rm_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id " & _
-    "AND lpu.rep_id=" & rep_id & " AND lpu.rm_id=lpu_budget.rm_id AND lpu.rm_id=" & rm_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds, lpu.rm_id AS rm_id " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .Name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cdbRM
->>>>>>
-Attribute VB_Name = "cdbRM"
-Option Explicit
-
-Public Type tRMID_COMMON
-    rm As tREGMAN
-    rgcd_count As Integer
-    rgcd() As tREGION
-End Type
-
-Function Get_RM_CommonList_by_QTR(ByRef rmcd() As tRMID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_RM_CommonList_by_QTR = dbGet_RM_CommonList_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_RM_CommonList_by_QTR(dbConnection As Object, ByRef rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    ' �������� ������ RM-��
-    Dim count As Integer
-    count = db_get_All_RM_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    Dim i As Integer
-    For i = 1 To count
-        rmcd(i).rgcd_count = 1
-        ReDim rmcd(i).rgcd(1 To 1)
-        getREGION_by_QTR ent_date, rmcd(i).rgcd(1), rmcd(i).rm.rm_id
-    Next i
-    dbGet_RM_CommonList_by_QTR = count
-End Function
-
-Function db_get_All_RM_by_QTR(dbConnection As Object, rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    
-    Dim count_sql As String
-    Dim get_sql As String
-    Dim rs As Object
-    Dim RM_Count As Integer
-        
-    count_sql = "SELECT COUNT(*) AS RM_TOTAL FROM reg_man"
-    get_sql = "SELECT * FROM reg_man"
-    Set rs = CreateObject("ADODB.Recordset")
-    rs.Open count_sql, dbConnection
-    
-    If Not rs.BOF Then
-        RM_Count = rs("RM_TOTAL")
-    End If
-    
-    rs.Close
-    
-     db_get_All_RM_by_QTR = RM_Count
-    
-    If RM_Count > 0 Then
-        'we have records
-        ReDim rmcd(1 To RM_Count)
-        Dim index As Long
-        index = 1
-        rs.Open get_sql, dbConnection
-        
-        If Not rs.BOF Then
-             Do While Not rs.EOF
-                 Dim tmp_rmcd As tRMID_COMMON
-                 With tmp_rmcd
-                    .rgcd_count = 0
-                    .rm.City = rs("city")
-                    .rm.FirstName = rs("firstname")
-                    .rm.LastName = rs("lastname")
-                    .rm.rm_id = rs("mgr_id")
-                    .rm.Region = rs("region")
-                 End With
-                 
-                 rmcd(index) = tmp_rmcd
-                 index = index + 1
-                 rs.MoveNext
-             Loop
-        End If
-    End If
-    
-End Function
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-           With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub CreateExtCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom extendet commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Add New Slide"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 280
-                .OnAction = "cmAddSlide"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        Application.ScreenUpdating = False
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        Application.ScreenUpdating = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmNewReport()
-    ppReport.CreateReport
-    MsgBox "����� ����� ������", vbInformation + vbOKOnly, PROGRAM_NAME
-    CreateExtCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmOpenReport()
-    Dim fileToOpen
-    Dim s As String
-    fileToOpen = Application _
-        .GetOpenFileName("Report Files (*.ppt), *.ppt", title:="Report OPen", MultiSelect:=False)
-    If fileToOpen <> False Then
-        s = fileToOpen
-        ppReport.OpenReport s
-        CreateExtCommandBar theApp:=ThisWorkbook.Application
-    End If
-End Sub
-
-Sub cmCloseReport()
-    On Error Resume Next
-    ppReport.SaveReport
-    CreateCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmAddSlide()
-    ThisWorkbook.ActiveSheet.PrintCopy
-    ppReport.InsertSlide
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("PRJ_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Unprotect
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("LPU_LIST")
-        s = .Range("C4") & " " & .Range("C3") & ", " & .Range("G4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-End Sub
-
-Sub btLPU_DEL_IT()
-'    Dim cLPU As tLPU
-'    Dim ent_date As String
-'    Dim delete_all As Integer
-'    Dim dlg_del As dlg_LPU_delete
-'
-'    With Worksheets("LPU_LIST")
-'        ent_date = .Range("ent_date")
-'        cLPU.id = .getCurrentLPU_ID()
-'    End With
-'
-'    If cLPU.id = 0 Then
-'        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-'        Exit Sub
-'    End If
-'    cLPU = Get_LPU_Record(cLPU.id)
-'
-'    Set dlg_del = New dlg_LPU_delete
-'    With dlg_del
-'        .chbDeleteQTR.Value = True
-'        .chbDeleteAll.Value = False
-'        .lComment = ent_date & ": �������� ��� '" _
-'        & cLPU.Name & "', �������������� �� ������:" _
-'        & cLPU.address & " �� ���������."
-'        .Show
-'    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    rm_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-        .rm_id = rm_id
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.rm_id = dbRecordset("rm_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id, rm_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    Dim rep_sql As String
-    Dim rm_sql As String
-    
-    rep_sql = ""
-    rm_sql = ""
-    
-    If rep_id <> 0 Then
-        rep_sql = " AND rep_id=" & rep_id
-    End If
-    
-    If rm_id <> 0 Then
-        rm_sql = " AND rm_id=" & rm_id
-    End If
-    
-    
-        getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql
-        getAll_QTR_SQL = "SELECT * FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql & " ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{92648543-CB84-4B6B-BEB3-539AE7EF9D84}{7E20E3E3-027A-483B-A14D-AA9EA5398ACC}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "��������� �����: " & Range("title")
-    Range("view_key") = False
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(%): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{067FED69-B41E-427D-AF59-5798B8E2E73A}{4C13CAB1-FDCC-4708-89EB-E92EDC125712}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id, objQTR.rm_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "���� ������: " & Range("title")
-    
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� ������: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "������� ���: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{9C81F4D2-4ECF-46F5-999B-9801D572A12F}{B382508B-7F3D-4747-8407-0F75F6F265F5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{EA8CE4CE-AC2E-45BC-BAF8-1429E6242097}{575F0762-04F4-4F86-B98A-8E87E3424B0D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(rep_id As Long, rm_id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, rep_id As Long, rm_id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT * FROM " & _
-          "rep WHERE rep_id=" & rep_id & " AND rm_id=" & rm_id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.rm_id = dbRecordset("rm_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    If rm_id <> 0 Then
-        Where = Where & " AND rep.rm_id=" & rm_id
-    End If
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record(Range("RM_ID"))
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN, Range("RM_ID"))
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record(rm_id As Long) As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSet_REGMAN_Record dbConnection, cREGMAN
-'    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object, rm_id As Long) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    objREGMAN.rm_id = rm_id
-    sql = "SELECT * FROM " & _
-          "reg_man WHERE mgr_id=" & rm_id
-          
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM reg_man"
-'    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREGMAN.FirstName & "', " & _
-'    "'" & objREGMAN.LastName & "', " & _
-'    objREGMAN.Region & ", " & _
-'    objREGMAN.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    Name As String
-End Type
-
-Public Type tDBTABLE
-    Name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).Name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).Name = "entry_date"
-    tables(1).field(2).Name = "bdgt_NMG"
-    tables(1).field(3).Name = "bdgt_NFG"
-    tables(1).field(4).Name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).Name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).Name = "entry_date"
-    tables(2).field(2).Name = "operations_per_quarter"
-    tables(2).field(3).Name = "risk_percent"
-    tables(2).field(4).Name = "patients_with_risk_ON"
-    tables(2).field(5).Name = "patients_ambulator"
-    tables(2).field(6).Name = "patients_ambulator_nmg"
-    tables(2).field(7).Name = "patients_ambulator_clexan"
-    tables(2).field(8).Name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).Name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).Name = "patients_stationar_nmg"
-    tables(2).field(11).Name = "patients_stationar_clexan"
-    tables(2).field(12).Name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).Name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).Name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).Name = "entry_date"
-    tables(3).field(2).Name = "patients_with_geparins"
-    tables(3).field(3).Name = "patients_per_quarter"
-    tables(3).field(4).Name = "patients_stationar_nmg"
-    tables(3).field(5).Name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).Name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).Name = "entry_date"
-    tables(4).field(2).Name = "patients_with_geparins"
-    tables(4).field(3).Name = "patients_per_quarter"
-    tables(4).field(4).Name = "patients_stationar_nmg"
-    tables(4).field(5).Name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).Name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).Name = "entry_date"
-    tables(5).field(2).Name = "patients_per_quarter"
-    tables(5).field(3).Name = "risk_percent"
-    tables(5).field(4).Name = "patients_with_risk_ON"
-    tables(5).field(5).Name = "patients_ambulator"
-    tables(5).field(6).Name = "patients_ambulator_nmg"
-    tables(5).field(7).Name = "patients_ambulator_clexan"
-    tables(5).field(8).Name = "patients_stationar_nmg"
-    tables(5).field(9).Name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).Name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).Name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).Name) = getRS(tables(tbl_idx).field(fld_idx).Name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 10)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    tables_to_clear(9) = "quarter_rm"
-    tables_to_clear(10) = "reg_man"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-cdbPRJ
->>>>>>
-Attribute VB_Name = "cdbPRJ"
-Option Explicit
-
-Type tPROJECT
-    total_SALE  As Long ' ����� ����� ������
-    total_BDGT  As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU   As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_RM    As Long ' ����� �����
-    total_BEDS  As Long ' ����� ����� ����
-    total_HIR   As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER   As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS   As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN   As Long '  ���� ������ ��������
-    objRGN() As tREGION
-End Type
-
-Function GetPRJ_COMM_DATA(ByRef prj_data As tPROJECT) As Integer
-    Dim i As Integer
-    i = GetRGN_COMM_DATA(prj_data.objRGN, 0)
-    GetPRJ_COMM_DATA = i
-    If i > 0 Then
-        With prj_data
-            .sale_PLAN = 0
-            .total_ACS = 0
-            .total_BDGT = 0
-            .total_BDGT_NMG = 0
-            .total_BEDS = 0
-            .total_HIR = 0
-            .total_LPU = 0
-            .total_REP = 0
-            .total_RM = 0
-            .total_SALE = 0
-            .total_TER = 0
-            For i = 1 To UBound(prj_data.objRGN)
-                
-            Next i
-        End With
-    End If
-
-End Function
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-        .setEnt_date (getEnt_date())
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("RM_ID") = rm_id
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    Dim rm_struc As tREGMAN
-    
-    i = Range("RM_ID")
-    rm_struc = Get_REGMAN_Record(i)
-    
-    Range("C4") = rm_struc.LastName
-    Range("C5") = rm_struc.FirstName
-
-    Range("G5") = GetRegionName(rm_struc.Region)
-    
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date, Range("RM_ID"))
-
-    
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_LIST")
-        s = .Range("C5") & " " & .Range("C4") & ", " & .Range("G5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("REP_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date, rm_id)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id, allREPID(i).rm_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    rm_id As Long
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION, rm_id As Long) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date, rm_id)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_REP_count As Integer
-            reg_data(i).rm_id = rm_id
-            reg_data(i).ent_date = q_date(i)
-            current_REP_count = getREGION_by_QTR(q_date(i), reg_data(i), rm_id)
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-' if rm_id = 0 then gets all records
-Function getAllQTRNames(ByRef qtr_lst() As String, rm_id As Long) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    
-    If rm_id <> 0 Then
-        sql = sql & " WHERE rm_id=" & rm_id
-    End If
-    
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION, rm_id As Long) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tQTR_COMMON
-    rep_count = Get_QTR_CommonList_by_REP(reps, ent_date, 0, rm_id)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .c_bdgt_NFG + .c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtr.sale_PLAN
-                treg.total_SALE = treg.total_SALE + .c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .c_pat_HIR
-                treg.total_TER = treg.total_TER + .c_pat_TER
-                treg.total_ACS = treg.total_ACS + .c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .i_lcd
-                treg.total_BEDS = treg.total_BEDS + .c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-'            def_dir = GetWBPath(ThisWorkbook.FullName)
-'            If GetImportDirectory(def_dir, flist) Then
-'                Dim db_list() As String
-'                i = GetDBList(flist, db_list)
-'                If i > 0 Then
-'                    ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-'                End If
-'            End If
-'            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Range("ret_addr") = "RM_QTR"
-            Worksheets("REP_LIST").setEnt_date (Worksheets(RM_QTR_SHEET).getEnt_date())
-            Worksheets("REP_LIST").Range("RM_ID") = Worksheets(RM_QTR_SHEET).Range("RM_ID")
-            Worksheets("REP_LIST").Range("VIEW_ONLY") = True
-
-            Worksheets("REP_LIST").Select
-        Case 3
-            MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub btRM_QTR_RET_IT()
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cPPReport
->>>>>>
-Attribute VB_Name = "cPPReport"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Const PPR_NON As Integer = 0
-Const PPR_NEW As Integer = 1
-Const PPR_OLD As Integer = 2
-
-Dim ReportApp As PowerPoint.Application
-Dim ReportDoc As PowerPoint.Presentation
-Dim ReportState As Integer
-Dim PowerPointPath As String
-
-Private Sub Class_Initialize()
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    PowerPointPath = ReportApp.Path & "\PowerPNT.EXE"
-    ReportState = PPR_NON
-End Sub
-
-Sub OpenReport(FileName As String)
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = GetObject(FileName)
-    ReportState = PPR_OLD
-End Sub
-
-Sub CreateReport()
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = ReportApp.Presentations.Add
-    ReportState = PPR_NEW
-End Sub
-
-Sub SaveReport()
-    Select Case ReportState
-        Case PPR_NEW
-            ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME
-        Case PPR_OLD
-            ReportDoc.Save
-    End Select
-    ReportState = PPR_NON
-End Sub
-
-Sub ReportView()
-    Dim CmdName As String
-    CmdName = GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME + ".PPT"
-    CmdName = PowerPointPath & " " & CmdName
-    Shell CmdName, 1
-End Sub
-
-Sub InsertSlide()
-    Dim ReportPage As PowerPoint.Slide
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.count + 1, ppLayoutBlank)
-    
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = "Slide #" & Format(ReportDoc.Slides.count)
-End Sub
-
-
-Private Sub Class_Terminate()
-    SaveReport
-    ReportApp.Quit
-End Sub
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{36355920-F7A4-44A8-96EF-5D79CF26137D}{F852BDF2-AB3E-468E-89DF-EC5DC0C7C88B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-rmImport
->>>>>>
-Attribute VB_Name = "rmImport"
-Option Explicit
-
-Public Type dbDESCRIPTION
-    Name As String
-    Fields() As String
-End Type
-
-Sub ImportFromRegionalManagers(rm_files() As String, fm_file As String)
-    Dim db(9) As dbDESCRIPTION
-    
-    '''''data
-    db(1).Name = "rep"
-    
-    db(2).Name = "lpu"
-    db(3).Name = "lpu_acs"
-    db(4).Name = "lpu_budget"
-    db(5).Name = "lpu_hir"
-    db(6).Name = "lpu_im"
-    db(7).Name = "lpu_ter"
-    db(8).Name = "quarter"
-    db(9).Name = "quarter_rm"
-    
-    ReDim db(1).Fields(5)
-    With db(1)
-        .Fields(1) = "rep_id"
-        .Fields(2) = "firstname"
-        .Fields(3) = "lastname"
-        .Fields(4) = "region"
-        .Fields(5) = "city"
-    End With
-    
-    ReDim db(2).Fields(5)
-    With db(2)
-        .Fields(1) = "id"
-        .Fields(2) = "rep_id"
-        .Fields(3) = "name"
-        .Fields(4) = "address"
-        .Fields(5) = "beds"
-    End With
-    
-    ReDim db(3).Fields(7)
-    With db(3)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(4).Fields(6)
-    With db(4)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "bdgt_NMG"
-        .Fields(5) = "bdgt_NFG"
-        .Fields(6) = "sale_PLAN"
-    End With
-    
-    ReDim db(5).Fields(15)
-    With db(5)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "operations_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_ambulator_clexan_40mg"
-        .Fields(11) = "patients_ambulator_clexan_20mg"
-        .Fields(12) = "patients_stationar_nmg"
-        .Fields(13) = "patients_stationar_clexan"
-        .Fields(14) = "patients_stationar_clexan_40mg"
-        .Fields(15) = "patients_stationar_clexan_20mg"
-    End With
-    
-    
-    ReDim db(6).Fields(7)
-    With db(6)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(7).Fields(11)
-    With db(7)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_stationar_nmg"
-        .Fields(11) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(8).Fields(9)
-    With db(8)
-        .Fields(1) = "ID"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "rep_id"
-        .Fields(4) = "sale_plan"
-        .Fields(5) = "ClxnH20mg"
-        .Fields(6) = "ClxnH40mg"
-        .Fields(7) = "ClxnT40mg"
-        .Fields(8) = "ClxnC_IM"
-        .Fields(9) = "ClxnC_ACS"
-    End With
-    
-    ReDim db(9).Fields(3)
-    With db(9)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "sale_plan"
-    End With
-    
-    Dim rm_idx As Integer
-    Dim to_db As Object
-    'back uo
-    Merge_BackUp_All_Data
-    
-    'clean up
-    Merge_Clear_All_Data fm_file
-    
-    Set to_db = dbGetConnection(fm_file)
-    
-    For rm_idx = 1 To UBound(rm_files)
-        Dim from_db As Object
-        
-        Set from_db = dbGetConnection(rm_files(rm_idx))
-        
-        Dim new_rm_id As Long
-        new_rm_id = dbMergeRM(from_db, to_db)
-
-        Dim i As Integer
-
-        For i = 1 To UBound(db)
-            Dim get_sql As String
-            Dim getRS As Object
-            Dim insRS As Object
-            Dim field_idx As Integer
-                        
-            get_sql = "SELECT * FROM " & db(i).Name
-            Set getRS = CreateObject("ADODB.Recordset")
-            Set insRS = CreateObject("ADODB.Recordset")
-            insRS.Open db(i).Name, to_db, 2, 2
-
-            getRS.Open get_sql, from_db
-            
-            If Not getRS.BOF Then
-                Do While Not getRS.EOF
-                    insRS.addnew
-                    Dim fld_name As String
-                    
-                    For field_idx = 1 To UBound(db(i).Fields)
-                        fld_name = db(i).Fields(field_idx)
-                        insRS(fld_name) = getRS(fld_name)
-                    Next field_idx
-                    
-                    insRS("rm_id") = new_rm_id
-                    insRS.Update
-                    getRS.MoveNext
-                Loop
-            
-            Else
-                'empty table
-                ' do nothing
-            End If
-            
-            
-        Next i
-        
-        dbCloseOpenedConnection from_db
-    Next rm_idx
-    
-    dbCloseOpenedConnection to_db
-End Sub
-
-Function dbMergeRM(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM reg_man"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about Regional Manager! This database cannot be merged!!!"
-            dbMergeRM = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "reg_man", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    dbMergeRM = insertRecordset("mgr_id")
-    
-End Function
-
-Sub cmDataImport()
-    Dim def_dir As String
-    Dim flist() As String
-    Dim i As Integer
-
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        
-        If i > 0 Then
-            ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-        End If
-    End If
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-
-<<<<<<
-======================
-PRJ_QTR
->>>>>>
-Attribute VB_Name = "PRJ_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CPRJ_QT As Integer = 0
-Const CPRJ_ID As Integer = 1
-Const CPRJ_PLN As Integer = 2
-Const CPRJ_FCT As Integer = 3
-Const CPRJ_BDG As Integer = 4
-Const CPRJ_CNT As Integer = 5
-Const CPRJ_BEDS As Integer = 6
-Const CPRJ_HIR As Integer = 7
-Const CPRJ_TER As Integer = 8
-Const CPRJ_CRD As Integer = 9
-Const CPRJ_CLXN_BDG As Integer = 10
-Const CPRJ_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("PRJ_QTR")
-        s = "��� �������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tREGION
-    Dim i As Long
-    Dim r As Range
-
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objQTR(), 0)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CPRJ_QT) = objQTR(i).ent_date
-            r.Offset(i - 1, CPRJ_ID) = ""
-            r.Offset(i - 1, CPRJ_PLN) = objQTR(i).sale_PLAN
-            r.Offset(i - 1, CPRJ_FCT) = objQTR(i).total_SALE
-            r.Offset(i - 1, CPRJ_BDG) = objQTR(i).total_BDGT
-            r.Offset(i - 1, CPRJ_CNT) = objQTR(i).total_LPU
-            r.Offset(i - 1, CPRJ_BEDS) = objQTR(i).total_REP
-            r.Offset(i - 1, CPRJ_HIR) = objQTR(i).total_HIR
-            r.Offset(i - 1, CPRJ_TER) = objQTR(i).total_TER
-            r.Offset(i - 1, CPRJ_CRD) = objQTR(i).total_ACS
-            If objQTR(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_BDG) = objQTR(i).total_SALE / objQTR(i).total_BDGT
-            End If
-            If objQTR(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_NMG) = objQTR(i).total_SALE / objQTR(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CPRJ_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_CLXN_NMG + 1)
-        End If
-    Next i
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Public Sub cbxPRJ_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_PRJ
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_PRJ
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_PRJ
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = PRJ_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CPRJ_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "PRJ_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btPRJ_QTR_Do_IT ' old btRM_OTR_DO_IT
-End Sub
-
-<<<<<<
-======================
-RM_LIST
->>>>>>
-Attribute VB_Name = "RM_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentRM_ID() As Long
-    Dim r As Range
-
-    With Worksheets("RM_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CRM_ID)
-    End With
-
-    getCurrentRM_ID = r
-End Function
-
-Public Sub RM_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("PM_CHR_IDX")
-        Case 1
-            Rm_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rm_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rm_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-
-        Case 4
-            Rm_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectRM_QTR(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "RM_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("RM_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Public Sub SelectREP_LIST(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "REP_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .setEnt_date (getEnt_date())
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateRMList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Sub UpdateRMList()
-    Dim rmcd() As tRMID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_RM_CommonList_by_QTR(rmcd(), ent_date)
-
-    With ThisWorkbook.Worksheets("RM_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rmcd)
-            r.Offset(i - 1, CRM_NAME) = GetRegionName(rmcd(i).rm.Region)
-            r.Offset(i - 1, CRM_ID) = rmcd(i).rm.rm_id
-            r.Offset(i - 1, CRM_BEDS) = rmcd(i).rgcd(1).total_BEDS
-            r.Offset(i - 1, CRM_BDGT) = rmcd(i).rgcd(1).total_BDGT
-            r.Offset(i - 1, CRM_NMG) = rmcd(i).rgcd(1).total_BDGT_NMG
-            r.Offset(i - 1, CRM_HIR) = rmcd(i).rgcd(1).total_HIR
-            r.Offset(i - 1, CRM_TER) = rmcd(i).rgcd(1).total_TER
-            r.Offset(i - 1, CRM_CAR) = rmcd(i).rgcd(1).total_ACS
-            r.Offset(i - 1, CRM_FACT) = rmcd(i).rgcd(1).total_SALE
-            r.Offset(i - 1, CRM_PLAN) = rmcd(i).rgcd(1).sale_PLAN
-            
-            With rmcd(i).rgcd(1)
-                r.Offset(i - 1, CRM_PAT_LPU) = .total_HIR + .total_TER + .total_ACS
-            End With
-            
-            r.Offset(i - 1, CRM_BDGT_1) = rmcd(i).rgcd(1).total_BDGT
-            If rmcd(i).rgcd(1).total_BDGT > 0 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = rmcd(i).rgcd(1).total_SALE / rmcd(i).rgcd(1).total_BDGT
-            End If
-            If r.Offset(i - 1, CRM_BDGT_1 + 1) > 1 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CRM_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CRM_AREA).row, CRM_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CRM_AREA).Column
-
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CRM_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CRM_NAME
-        Range("JUMP") = ""
-    Else
-        btRM_LIST_DO_IT
-    End If
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-<<<<<<
-======================
-mPRJ_QTR
->>>>>>
-Attribute VB_Name = "mPRJ_QTR"
-Sub btPRJ_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("PRJ_ACTION")
-    ent_date = Worksheets(PRJ_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            cmDataImport
-        Case 2
-            Worksheets("RM_LIST").setEnt_date (Worksheets("PRJ_QTR").getEnt_date())
-            Worksheets("RM_LIST").Range("ret_addr") = "PRJ_QTR"
-            Worksheets("RM_LIST").Select
-        Case 3
-            cmNewReport
-    End Select
-    Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-End Sub
-
-
-<<<<<<
-======================
-mRM_LIST
->>>>>>
-Attribute VB_Name = "mRM_LIST"
-Option Explicit
-
-Public Const CRM_AREA As String = "B12"
-Public Const CRM_NAME As Integer = 0
-Public Const CRM_NAME1 As Integer = 1
-Public Const CRM_NAME2 As Integer = 2
-Public Const CRM_ID As Integer = 3
-Public Const CRM_BEDS As Integer = 4
-Public Const CRM_BDGT As Integer = 5
-Public Const CRM_NMG As Integer = 6
-Public Const CRM_HIR As Integer = 7
-Public Const CRM_TER As Integer = 8
-Public Const CRM_CAR As Integer = 9
-Public Const CRM_FACT As Integer = 10
-Public Const CRM_PLAN As Integer = 11
-Public Const CRM_PAT_LPU As Integer = 16
-Public Const CRM_BDGT_1 As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(CRM As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_LIST")
-        s = "�������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub Rm_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub Rm_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CRM_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub btRM_LIST_RET_IT()
-    With Worksheets("RM_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "PRJ_QTR"
-    End With
-    ThisWorkbook.Worksheets("PRJ_QTR").Activate
-End Sub
-
-
-Sub btRM_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rm_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("RM_LIST_ACTION")
-    With Worksheets("RM_LIST")
-        rm_id = .getCurrentRM_ID()
-        
-        Select Case i
-            Case 1:
-                .SelectRM_QTR rm_id
-            Case 2:
-                .SelectREP_LIST rm_id
-            End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-
-<<<<<<
-Project Name : 'ClexaneMR'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).ClearRepName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(REP_QTR_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-Const CQTR_PAT_ALL As Integer = 16
-Const CQTR_BDGT_ALL As Integer = 17
-
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRepName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-    Range("H5") = ""
-End Sub
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREP
-    
-    cRep = GetREPRecord
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-    
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    i = GetAll_QTR_Records(objQTR, "%")
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList(qcd)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_plan
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_BBL_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-
-Private Sub Worksheet_Activate()
-  
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-    
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CRow_Width Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-    
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub DO_New_qtr()
-    Dim res As Variant
-    Dim objQTR As tQTR
-    Dim s As String
-    s = GetLastQtr
-    objQTR.entry_date = GetNextQTR(s)
-    
-    If objQTR.entry_date = "" Then
-        Exit Sub
-    End If
-    
-    DO_Price_qtr objQTR.entry_date
-
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        Dim qtr As tQTR
-        Dim res As Integer
-        
-        qtr = Get_QTR_Record(ent_date)
-        
-        If qtr.id = 0 Then
-            qtr.entry_date = ent_date
-    
-            With Worksheets(VAR_SHEET)
-                qtr.ClxnH20mg = .Range("ClxnH20mg")
-                qtr.ClxnH40mg = .Range("ClxnH40mg")
-                qtr.ClxnT40mg = .Range("ClxnT40mg")
-                qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-                qtr.ClxnC_IM = .Range("ClxnC_IM")
-            End With
-        End If
-        
-        Dim dlg_nq As dlg_nextQTR
-        Set dlg_nq = New dlg_nextQTR
-        
-        With dlg_nq
-            .tb_qtr_name = qtr.entry_date
-            .tb_bdgt_avts = qtr.sale_plan
-            .tb_qtr_name = qtr.entry_date
-            .tb_ClxnH20mg = qtr.ClxnH20mg
-            .tb_ClxnH40mg = qtr.ClxnH40mg
-            .tb_ClxnT40mg = qtr.ClxnT40mg
-            .tb_ClxnC_ACS = qtr.ClxnC_ACS
-            .tb_ClxnC_IM = qtr.ClxnC_IM
-        End With
-        
-        dlg_nq.Show
-        res = dlg_nq.Tag
-        
-        If res = vbOK Then
-            With dlg_nq
-                If Not IsNumeric(.tb_bdgt_avts) Then
-                    MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                Else
-                    If .tb_bdgt_avts = 0 Then
-                        MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                        Exit Sub
-                    End If
-                End If
-                Dim bool As Boolean
-                bool = IsNumeric(.tb_ClxnH20mg) _
-                    And IsNumeric(.tb_ClxnH40mg) _
-                    And IsNumeric(.tb_ClxnT40mg) _
-                    And IsNumeric(.tb_ClxnC_ACS) _
-                    And IsNumeric(.tb_ClxnC_IM)
-                If Not bool Then
-                    MsgBox "������� ��������� �����", vbOK, PROGRAM_NAME
-                    Exit Sub
-                End If
-                qtr.sale_plan = .tb_bdgt_avts
-                qtr.entry_date = .tb_qtr_name
-                qtr.ClxnH20mg = .tb_ClxnH20mg
-                qtr.ClxnH40mg = .tb_ClxnH40mg
-                qtr.ClxnT40mg = .tb_ClxnT40mg
-                qtr.ClxnC_ACS = .tb_ClxnC_ACS
-                qtr.ClxnC_IM = .tb_ClxnC_IM
-            End With
-            Insert_QTR_Record qtr
-        End If
-    End If
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = False
-            .Range("ent_date") = ent_date
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        Dim i As Integer
-        i = MsgBox("������� ������ �� ������ [" & ent_date & "]?", vbDefaultButton2 + vbOKCancel, PROGRAM_NAME)
-        If i = vbOK Then
-            Dim objQTR As tQTR
-            If ent_date <> "" Then
-                objQTR.entry_date = ent_date
-                objQTR = Get_QTR_Record(ent_date)
-                Delete_QTR_Record objQTR
-                Worksheets(TITLE_SHEET).Select
-                Worksheets(REP_QTR_SHEET).Select
-            End If
-        End If
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            DO_New_qtr
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            dbExport
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    End Select
-    If idx <> 2 Then
-        With ThisWorkbook
-            .Worksheets(TITLE_SHEET).Select
-            .Worksheets(REP_QTR_SHEET).Select
-        End With
-    End If
-End Sub
-
-Sub Delete_qtr()
-    Dim ent_date As String
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    DO_Delete_qtr ent_date
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[MR]"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-    
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-    
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-        
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-                   
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-       
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CINP_WIDTH Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-    
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-        
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    lpu_id = r
-    
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-    
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-    
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-            
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-        
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-        
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-        
-        Case Else
-            Range("JUMP") = ""
-    End Select
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-    
-    is_input_range = INPUT_NO
-    
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-    
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREP
-    
-    ' ent_date = "%" ' % - all records
-    ent_date = getEnt_date
-    
-    objQTR = Get_QTR_Record(ent_date)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-     
-    ' ������� ���
-    Range("C3:C4").ClearContents
-    cRep = GetREPRecord
-    
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_plan
-    
-
-    
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-        
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-            
-         
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_plan
-            
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-            
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{566B33D6-957A-43E4-8444-D8EA3889700C}{42EE65B8-F8C6-4F95-9F52-7738BF6FCEAD}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-    
-        Dim objHir As tHIRURGIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.Count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-        
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-    
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-            Application.ScreenUpdating = False
-            
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-            
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{EBA94131-180E-4709-A2A3-B60D48987620}{47A860A1-BF92-4EBB-A333-AB7E83FAB868}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_plan = Round(Range("F13").Value, 0)
-            
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_plan
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_plan <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("��������� ������� ��������?", vbYesNo, PROGRAM_NAME) Then
-                    Insert_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-    
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_plan
-    
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    objQTR = Get_QTR_Record(ent_date)
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-    
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-        
-        SetupData cLPU
-        
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case INPUT_CHECK
-            
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{E3F10C5A-A4B4-42FF-A2C9-6F8198210A07}{563D0F3D-F79D-48F1-AFE4-A2136809B982}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{137EDDE5-3DB4-4BAD-A245-324DC31ABB36}{3BD7159A-BF6C-403F-B3DF-4834FA9E4D92}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{8EB80D4C-3476-421A-A370-6332A07DE509}{A7542905-C9F8-4F39-AD67-B62A88F8F4E6}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREP
->>>>>>
-Attribute VB_Name = "mREP"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSetREPRecord
-    With Worksheets("REP_QTR")
-        .ClearRepName
-        .Range("REP_QTR_INPUT_DATA").ClearContents
-        .Range("QTR_SEL") = ""
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-        Worksheets("REP_QTR").Range("QTR_SEL") = ""
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cUser As tREP
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cUser = GetREPRecord()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cUser.Region
-        .Range("IDX_CITY") = cUser.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cUser.Region
-        .cbCity = cUser.City
-        .tbFName = cUser.FirstName
-        .tbLName = cUser.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cUser
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        SetREPRecord cUser
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_plan As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim SQL As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_plan = 0
-    End With
-        
-    
-    SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_plan = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_plan = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_plan
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_plan & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPU(allLPU() As tLPU) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPU = dbGetAllLPU(dbConnection, allLPU)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPUbyQTR(allLPU() As tLPU, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPUbyQTR = dbGetAllLPUbyQTR(dbConnection, allLPU, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objLPU.id = 0 then insert else update
-Sub Insert_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    If objLPU.id = 0 Then
-        dbInsert_LPU_Record dbConnection, objLPU
-    Else
-        dbUpdate_LPU_Record dbConnection, objLPU
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub Delete_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDelete_LPU_Record dbConnection, objLPU
-    dbCloseConnection dbConnection
-End Sub
-
-Sub Delete_LPU_RecordQTR(ByRef objLPU As tLPU, ent_date As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-    dbCloseConnection dbConnection
-    
-End Sub
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim SQL As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    SQL = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Sub dbInsert_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-  
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu", dbConnection, 2, 2
-    dbRecordset.addnew
-    dbRecordset("name") = objLPU.name
-    dbRecordset("address") = objLPU.address
-    dbRecordset("rep_id") = objLPU.rep_id
-    dbRecordset("beds") = objLPU.beds
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objLPU.id = dbRecordset("id")
-  
-End Sub
-
-Sub dbUpdate_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu SET " & _
-    "name='" & objLPU.name & "'," & _
-    "address='" & objLPU.address & "'," & _
-    "beds=" & objLPU.beds & "," & _
-    "rep_id=" & objLPU.rep_id& & _
-    " WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-
-Function dbGetAllLPU(dbConnection As Object, allLPU() As tLPU) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu"
-    getAll_LPU_SQL = "SELECT * FROM lpu"
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPU = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAllLPUbyQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim where As String
-    where = "WHERE lpu_budget.entry_date like '" & ent_date & "'"
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget " & where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & where & " AND lpu.id=lpu_budget.lpu_id"
-    
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPUbyQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Sub dbDelete_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu " & _
-    "WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Hir_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Ter_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_ACS_RecordsByLPU_ID dbConnection, objLPU.id
-    
-End Sub
-
-Sub dbDelete_LPU_RecordQTR(dbConnection As Object, ByRef objLPU As tLPU, ent_date As String)
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-End Sub
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-Option Explicit
-
-Public Type tREP
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetREPRecord() As tREP
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetREPRecord = dbGetREPRecord(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub SetREPRecord(cUser As tREP)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSetREPRecord dbConnection, cUser
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSetREPRecord()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSetREPRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGetREPRecord(dbConnection As Object) As tREP
-    
-    Dim SQL As String
-    Dim objREP As tREP
-    
-    objREP.FirstName = ""
-    objREP.LastName = ""
-    objREP.Region = 0
-    objREP.City = 0
-    SQL = "SELECT firstname, lastname, region, city FROM " & _
-          "rep"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREP.FirstName = dbRecordset("firstname")
-        objREP.LastName = dbRecordset("lastname")
-        objREP.Region = dbRecordset("region")
-        objREP.City = dbRecordset("city")
-        
-    End If
-    
-    dbGetREPRecord = objREP
-        
-End Function
-
-Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREP.FirstName & "', " & _
-    "'" & objREP.LastName & "', " & _
-    objREP.Region & ", " & _
-    objREP.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-End Sub
-
-Public Sub dbReSetREPRecord(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("REP_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-'                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = Double2Str(.risk_percent, 3)
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub test()
-    Dim s As String
-    Dim d As Single
-    d = 1235.6789
-    s = Format(d, "####0,00")
-    MsgBox s
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    Dim del_request As Integer
-    Dim allLPU() As tLPU
-    Dim lpu_count As Integer
-    Dim i As Integer
-    Dim tmp_LPU_List As Range
-    Dim tmp_LPU_List_Addr As String
-    Dim r_end As Range
-    Dim dlg As Dlg_lpu_card
-    
-    Set dlg = New Dlg_lpu_card
-    
-    lpu_count = GetAllLPU(allLPU)
-    With Worksheets(VAR_SHEET)
-        Set tmp_LPU_List = .Range("tmp_LPU_List")
-        Set r_end = .Range(tmp_LPU_List, tmp_LPU_List.End(xlDown))
-        Set r_end = .Range(r_end, r_end.End(xlToRight))
-        .Range(tmp_LPU_List, r_end).ClearContents
-    End With
-        
-    If lpu_count <> 0 Then
-        dlg.cbxLPU_List_Enable.Enabled = True
-        For i = 1 To UBound(allLPU)
-            tmp_LPU_List.Cells(i, 1) = allLPU(i).name
-            tmp_LPU_List.Cells(i, 2) = allLPU(i).address
-            tmp_LPU_List.Cells(i, 3) = allLPU(i).beds
-            tmp_LPU_List.Cells(i, 4) = allLPU(i).id
-        Next i
-    Else
-        dlg.cbxLPU_List_Enable.Enabled = False
-    End If
-    
-    tmp_LPU_List_Addr = Worksheets(VAR_SHEET).name & "!" & _
-            Worksheets(VAR_SHEET).Range(tmp_LPU_List, tmp_LPU_List.End(xlDown)).address
-
-    With dlg
-        .cbLPU_List.RowSource = tmp_LPU_List_Addr
-        .cbLPU_List.ListIndex = 0
-        .cbxLPU_List_Enable = False
-        .cbLPU_List.Enabled = False
-        If cLPU.id <> 0 Then
-            .cbxLPU_List_Enable.Enabled = False
-        Else
-            If lpu_count <> 0 Then
-                .cbxLPU_List_Enable.Enabled = True
-            Else
-                .cbxLPU_List_Enable.Enabled = False
-            End If
-        End If
-        .tb_lpu_name.Text = cLPU.name
-        .tb_lpu_address.Text = cLPU.address
-        .tbBedsCount = cLPU.beds
-
-        .Tag = vbCancel
-    End With
-    
-    dlg.Show
-    
-    If Not IsNumeric(dlg.Tag) Then
-        Exit Sub
-    End If
-    
-    If dlg.Tag = vbOK Then
-        Dim n As Variant
-        Dim test As Integer
-        test = 0
-        n = dlg.tbBedsCount.Value
-        If Not IsNumeric(n) Then
-            test = 1
-        Else
-            If n = 0 Then
-                test = 1
-            End If
-        End If
-        If test = 0 Then
-            
-            cLPU.name = dlg.tb_lpu_name.Text
-            cLPU.address = dlg.tb_lpu_address.Text
-            cLPU.beds = dlg.tbBedsCount.Value
-                                    
-            If cLPU.name = "" Or cLPU.address = "" Then
-                test = 2
-            End If
-        End If
-        Select Case test
-            Case 0
-                If dlg.cbxLPU_List_Enable.Value = True Then
-                    cLPU.id = tmp_LPU_List.Cells(dlg.cbLPU_List.ListIndex + 1, 4)
-                End If
-                Insert_LPU_Record cLPU
-                ' ��������� ������� ������ ��� ��� � ��������
-                Dim bdgt As tBUDGET
-                bdgt = Get_BDGT_Record(cLPU.id, ent_date)
-                ' ������ ���: ������� ������ ������ � lpu_budget
-                If bdgt.id = 0 Then
-                    bdgt.lpu_id = cLPU.id
-                    bdgt.entry_date = ent_date
-                    Insert_BDGT_Record bdgt
-                End If
-            Case 1
-                MsgBox "������� ��������� ���������� ������ ����� ��� 1!", vbOKOnly, PROGRAM_NAME
-            Case 2
-                MsgBox "������������ � ����� ��� �� ������ ���� �������!", vbOKOnly, PROGRAM_NAME
-        End Select
-    End If
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-    
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-    
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-    
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & "."
-        .Show
-        
-        If .Tag = vbOK Then
-            If .chbDeleteAll.Value Then
-                delete_all = _
-                    MsgBox("��� ������ �� ��� � ������ '" & cLPU.name & _
-                    "' ����� ������� ��������.", vbOK, PROGRAM_NAME)
-                If delete_all = vbOK Then
-                    Delete_LPU_Record cLPU
-                End If
-            Else
-                Delete_LPU_RecordQTR cLPU, ent_date
-            End If
-        End If
-    End With
-    
-    With ThisWorkbook
-        .Worksheets(TITLE_SHEET).Select
-        .Worksheets("LPU_LIST").Select
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Activate
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-        
-    
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id <> 0 And i = 1 Then
-            lpu_id = 0
-        End If
-        If lpu_id = 0 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1, 6
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                If lpu_id <> 0 Then
-                    .SelectLPU_BDGT lpu_id, ent_date
-                    .Range("JUMP") = "LPU_BDGT"
-                End If
-            Case 3
-                If lpu_id <> 0 Then
-                    .SelectLPU_HIR lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_HIR"
-                End If
-            Case 4
-                If lpu_id <> 0 Then
-                    .SelectLPU_TER lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_TER"
-                End If
-            Case 5
-                If lpu_id <> 0 Then
-                    .SelectLPU_C_ACS lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_C_ACS"
-                End If
-        End Select
-    End With
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_plan As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    Else
-        getLast_QTR_SQL = ""
-    End If
-    
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Sub Insert_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTR.id <> 0 Then
-        dbUpdate_QTR_Record dbConnection, objQTR
-    Else
-        dbInsert_QTR_Record dbConnection, objQTR
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTR_Record(ent_date As String) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, ent_date)
-    If i <> 0 Then
-        Get_QTR_Record = allQTR(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records(ByRef All_QTR() As tQTR, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTR_Records = dbGetAll_QTR_Records(dbConnection, All_QTR, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTR_Record dbConnection, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTR.ID <> 0 then updatre else insert
-Sub dbInsert_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTR
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_plan
-        dbRecordset("rep_id") = .rep_id
-        dbRecordset("ClxnH20mg") = .ClxnH20mg
-        dbRecordset("ClxnH40mg") = .ClxnH40mg
-        dbRecordset("ClxnT40mg") = .ClxnT40mg
-        dbRecordset("ClxnC_IM") = .ClxnC_IM
-        dbRecordset("ClxnC_ACS") = .ClxnC_ACS
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTR.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim Update_SQL As String
-    
-    With objQTR
-        Update_SQL = "UPDATE quarter SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rep_id=" & .rep_id & "," & _
-            "sale_plan=" & .sale_plan & "," & _
-            "ClxnH20mg=" & .ClxnH20mg & "," & _
-            "ClxnH40mg=" & .ClxnH40mg & "," & _
-            "ClxnT40mg=" & .ClxnT40mg & "," & _
-            "ClxnC_IM=" & .ClxnC_IM & "," & _
-            "ClxnC_ACS=" & .ClxnC_ACS & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTR_Records(dbConnection As Object, All_QTR() As tQTR, ent_date As String) As Integer
-    
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter WHERE entry_date like '" & ent_date & "'"
-    getAll_QTR_SQL = "SELECT * FROM quarter WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTR_Records = QTR_Count
-    
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim All_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_plan = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 All_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter " & _
-    "WHERE id=" & objQTR.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Hir_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Ter_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_ACS_RecordsByQTR dbConnection, objQTR.entry_date
-       
-End Sub
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList(ByRef qcd() As tQTR_COMMON) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList = dbGet_QTR_CommonList(dbConnection, qcd)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList(dbConnection As Object, ByRef qcd() As tQTR_COMMON) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, "%")
-    dbGet_QTR_CommonList = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_plan
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    On Error GoTo l_exit
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-l_exit:
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-        .EditDirectlyInCell = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{2FC04B4C-EB99-433E-ACDB-A920D02B9B5B}{777B85CC-ADE3-4188-94C8-9E07DA8B5076}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    On Error GoTo ExitLabel
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.Count
-                On Error Resume Next
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{3F7D7D75-90F6-4829-9E24-CA5391BB2A03}{A1A0F296-0D28-4123-8E38-82FA6EE6F2EF}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAllLPUbyQTR(dbConnection, allLPU, objQTR.entry_date)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-   
-    Unprotect
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-        
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{91AE5FA0-01C7-4C10-9E5F-D1D2DDF29401}{5726592A-BC0A-4E79-A963-35D354045716}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{FB055133-927F-41FF-BC90-442833A40591}{11BCAB43-1EDD-440B-AB0E-20CD6E42E11A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tID_REP
-    id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Public Type tID_REP_COMMON
-    id_rep As tID_REP
-    i_qtr As Long
-    qtrs As tQTR_COMMON
-End Type
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim last_qtr As String
-    
-    On Error GoTo ErrHandler
-    
-    last_qtr = GetLastQTR_fromDB
-    If last_qtr = "" Then
-        MsgBox "��� ������� � ���� ������. ������� ����������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & last_qtr & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub t()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-xTEST_NUM
->>>>>>
-Attribute VB_Name = "xTEST_NUM"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mSerialTNT
->>>>>>
-Attribute VB_Name = "mSerialTNT"
-Option Explicit
-Const MAX_NUM1 As Integer = ThirtySixBase
-Const MAX_NUM2 As Integer = ThirtySixBase ^ 2 / 2
-Const MAX_NUM3 As Integer = ThirtySixBase
-
-Const USERID_BASE As Long = ThirtySixBase ^ 3
-
-Const SRVC_BASE As Integer = 1000
-Const SRVC_MAX As Integer = 1999
-
-Const ORG_BASE As Integer = 100
-Const ORG_MAX As Integer = 199
-
-Sub test()
-    Dim user() As String
-    Dim i
-    Dim r As Range
-    Dim s As String
-    
-    Application.ScreenUpdating = False
-    
-    Dim calc_type As Integer
-    calc_type = Application.Calculation
-    Application.Calculation = xlCalculationManual
-   
-    Set r = Worksheets("TEST_SN").Range("B3")
-    For i = 0 To 50000
-        user = getNextSerial(1000, 100)
-        r = "'" & user(1)
-        r.Offset(0, 1) = "'" & user(2)
-        r.Offset(0, 2) = Len(user(1))
-        r.Offset(0, 3) = Len(user(2))
-        If i <> 0 Then
-            s = "=IF(" & r.Address & "=" & r.Offset(-1, 0).Address & ",1,0)"
-            r.Offset(0, 4).Formula = s
-        End If
-        Set r = r.Offset(1, 0)
-    Next i
-    
-    Application.Calculation = calc_type
-    Application.ScreenUpdating = False
-
-End Sub
-
-Function getNextSerial(srv As Integer, org As Integer) As String()
-    Dim num1 As Integer
-    Dim num2 As Integer
-    Dim num3 As Integer
-    Dim rdate As Long
-    Dim userID As Long
-    
-    num1 = nextNumber(MAX_NUM1)
-    num2 = nextNumber(MAX_NUM2)
-    num3 = nextNumber(MAX_NUM3)
-    
-    rdate = get_sn_date
-    
-    userID = nextUserID
-    
-    Dim serial As String
-    
-    serial = "" & srv & org & rdate & userID & num1 & num2 & num3
-    
-    Dim serial_SN As Integer
-    
-    serial_SN = get_serial_check_sum(serial)
-    
-    Dim login_1 As Long
-    Dim login_2 As Long
-    
-    Dim pass_1 As Long
-    Dim pass_2 As Long
-    
-    login_1 = "" & userID & serial_SN
-    login_2 = "" & num3 & rdate
-    
-    pass_1 = "" & num1 & srv
-    pass_2 = "" & num2 & org
-    
-    Dim out(2) As String
-    out(1) = Dec2ThirtySix(login_1) & Dec2ThirtySix(login_2)
-    out(2) = Dec2ThirtySix(pass_1) & Dec2ThirtySix(pass_2)
-    
-    getNextSerial = out
-End Function
-
-Function get_serial_check_sum(id_sn As String) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim chk As Integer
-    
-    s = id_sn
-    chk = 0
-    While s <> ""
-        i = Left(s, 1)
-        chk = (chk + i) Mod 10
-        s = Right(s, Len(s) - 1)
-    Wend
-    get_serial_check_sum = chk
-End Function
-
-Function get_sn_date() As Long
-    Dim d_date As Long
-    d_date = (Year(Now()) Mod 10)
-    d_date = d_date * 10000
-    d_date = d_date + Month(Now()) * 100
-    d_date = d_date + Day(Now())
-    get_sn_date = d_date
-End Function
-
-Function nextUserID() As Long
-    nextUserID = USERID_BASE + Int(Rnd() * USERID_BASE)
-End Function
-
-Function nextNumber(base As Integer) As Integer
-    nextNumber = base + Int(Rnd() * base)
-End Function
-
-Function serial_check_id_sum(id_sn As String) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim chk As Integer
-    
-    s = id_sn
-    chk = 0
-    While s <> ""
-        i = Left(s, 1)
-        chk = (chk + i) Mod 10
-        s = Right(s, Len(s) - 1)
-    Wend
-    serial_check_id_sum = chk
-End Function
-
-<<<<<<
-======================
-xTEST_SER
->>>>>>
-Attribute VB_Name = "xTEST_SER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Dec2TS
->>>>>>
-Attribute VB_Name = "Dec2TS"
-Option Explicit
-
-'Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-'Const ThirtySixBase As Integer = 36
-
-Public Const ThirtySixNumbers As String = "123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
-Public Const ThirtySixBase As Integer = 34
-
-Function randSN(Optional n As Integer = 34) As String
-    Dim t(ThirtySixBase) As String
-    Dim i As Integer
-    Dim j, k As Integer
-    Dim r As String
-    
-    For i = 1 To UBound(t)
-        t(i) = Mid(ThirtySixNumbers, i, 1)
-    Next i
-    For i = 1 To n
-        j = Int((ThirtySixBase * Rnd) + 1)
-        k = i Mod ThirtySixBase + 1
-        r = t(k)
-        t(k) = t(j)
-        t(j) = r
-    Next i
-    r = ""
-    For i = 1 To UBound(t)
-        r = r + t(i)
-    Next i
-    randSN = r
-End Function
-Function Dec2ThirtySix(ByVal Dec As Long) As String
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Double
-    
-    ThirtySixStr = TS
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If ThirtySixStr = "" Then
-        Dec = 0
-    Else
-        While ThirtySixStr <> ""
-            lastdigit = Right(ThirtySixStr, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            ThirtySixStr = Mid(ThirtySixStr, 1, Len(ThirtySixStr) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-
-Sub test()
-    Dim l As Long
-    l = ThirtySix2Dec("2HPI")
-    l = ThirtySix2ChkSum("2HPI")
-End Sub
-
-Function ThirtySix2ChkSum(TS As String) As Integer
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim chksum As Integer
-    
-    ThirtySixStr = TS
-
-    chksum = 0
-    
-    If ThirtySixStr = "" Then
-        chksum = 0
-    Else
-        While ThirtySixStr <> ""
-            lastdigit = Right(ThirtySixStr, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit) - 1
-            chksum = (chksum + idx) Mod ThirtySixBase
-            ThirtySixStr = Left(ThirtySixStr, Len(ThirtySixStr) - 1)
-        Wend
-    End If
-
-    ThirtySix2ChkSum = chksum
-End Function
-<<<<<<
-======================
-newItemDlg
->>>>>>
-Attribute VB_Name = "newItemDlg"
-Attribute VB_Base = "0{0B5E9521-7808-446E-9E61-7D38E1C2651A}{1C691B41-AC71-4558-927D-1487F1C50C72}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub AddSYS_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub resetSYS_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-<<<<<<
-======================
-Dec2Hex
->>>>>>
-Attribute VB_Name = "Dec2Hex"
-Option Explicit
-
-
-Const HexNumbers As String = "0123456789ABCDEF"
-Const HexBase As Integer = 16
-Const ThirtyNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRST"
-Const ThirtyBase As Integer = 30
-
-Function sDec2Hex(Dec As Long) As String
-    Dim HexStr As String
-    Dim idx As Integer
-    
-    HexStr = ""
-    
-    If Dec = 0 Then
-        HexStr = Mid(HexNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod HexBase
-            HexStr = Mid(HexNumbers, idx + 1, 1) + HexStr
-            Dec = Dec \ HexBase
-        Wend
-    End If
-    sDec2Hex = HexStr
-End Function
-
-Function Hex2Dec(HexString As String) As Long
-    Dim digit As Integer
-    Dim ch As String
-    Dim hexpower As Integer
-    Dim hexnum As String
-    Dim decnumber As Long
-    
-    hexnum = UCase(HexString)
-    hexpower = 0
-    decnumber = 0
-    
-    While hexnum <> ""
-        ch = Right(hexnum, 1)
-        hexnum = Left(hexnum, Len(hexnum) - 1)
-        digit = InStr(1, HexNumbers, ch, vbBinaryCompare)
-        decnumber = decnumber + digit ' power(hexbase, hexpower)
-        hexpower = hexpower + 1
-    Wend
-    Hex2Dec = decnumber
-End Function
-
-
-
-Function Dec2Thirty(Dec As Long) As String
-    
-    Dim ThirtyStr As String
-    Dim idx As Integer
-    
-    ThirtyStr = ""
-    
-    If Dec = 0 Then
-        ThirtyStr = Mid(ThirtyNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtyBase
-            ThirtyStr = Mid(ThirtyNumbers, idx + 1, 1) + ThirtyStr
-            Dec = Dec \ ThirtyBase
-        Wend
-    End If
-    Dec2Thirty = ThirtyStr
-End Function
-
-<<<<<<
-======================
-TEST_SN
->>>>>>
-Attribute VB_Name = "TEST_SN"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ETIME
->>>>>>
-Attribute VB_Name = "ETIME"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Long
-    Dim n As Long
-    n = 0
-    Do While Location.Offset(n, 0) <> ""
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub hide_sheets()
-    Dim ws As Worksheet
-    Dim wsname As String
-    For Each ws In ThisWorkbook.Worksheets
-        wsname = ws.Name
-        ws.Protect UserInterfaceonly:=True
-        If Left(wsname, 1) = "x" Then
-            ws.EnableCalculation = False
-            ws.Visible = xlSheetVeryHidden
-        End If
-    Next ws
-End Sub
-
-Sub show_sheets()
-    Dim ws As Worksheet
-    Dim wsname As String
-    For Each ws In ThisWorkbook.Worksheets
-        ws.Unprotect
-        wsname = ws.Name
-        If Left(wsname, 1) = "x" Then
-            ws.EnableCalculation = True
-            ws.Visible = xlSheetVisible
-        End If
-    Next ws
-End Sub
-
-Sub check_sn_seria()
-    Dim r1 As Range
-    Dim r2 As Range
-    Dim i As Long
-    Dim j As Long
-    
-    Dim calc_type As Integer
-    calc_type = Application.Calculation
-    Application.Calculation = xlCalculationManual
-    
-    Set r1 = Worksheets("OEM_100").Range("B7")
-    Set r2 = Worksheets("OEM_100").Range("C7")
-        
-    i = GetLinesCount(r1)
-    j = GetLinesCount(r2)
-    
-    Dim as1() As String
-    Dim as2() As String
-    
-    ReDim as1(i)
-    ReDim as2(j)
-    
-    i = 1
-    While r1 <> ""
-        as1(i) = r1
-        as2(i) = r2
-        Set r1 = r1.Offset(1, 0)
-        Set r2 = r2.Offset(1, 0)
-        i = i + 1
-    Wend
-    
-    Set r1 = Worksheets("OEM_100").Range("E6")
-    Set r2 = Worksheets("OEM_100").Range("E7")
-    
-    r1.EntireColumn.ClearContents
-    r1.Offset(0, 1).EntireColumn.ClearContents
-    r1.Select
-    
-    For i = 1 To UBound(as1)
-        r1 = i
-        For j = 1 To UBound(as2)
-            If as1(i) = as2(j) Then
-                r2 = i
-                r2.Offset(0, 1) = j
-                r1.Offset(0, 1) = r1.Offset(0, 1) + 1
-            End If
-        Next j
-    Next i
-    If r2.Row = 7 Then
-        r2 = ";-)"
-    End If
-    Application.Calculation = calc_type
-    Application.Calculate
-End Sub
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Sub Dom2_Stat()
-    Dim sr As Range
-    
-    Set sr = Worksheets("DOM2-Stat1w").Range("c7:e54")
-    
-    DelAllBlanks sr
-End Sub
-
-Sub Dom2_Stat2()
-    Dim sr As Range
-    
-    Set sr = Worksheets("DOM2-Stat2w").Range("e7:e92")
-    
-    DelAllPercentage sr
-End Sub
-
-Sub DelAllBlanks(ByRef r As Range)
-    Dim c As Range
-    Dim s_in As String
-    Dim s_out As String
-    Dim spaceIdx As Integer
-    
-    For Each c In r
-        s_in = c.Value2
-        s_out = Left(s_in, Len(s_in) - 4) + Right(s_in, 3)
-        c = s_out
-        c.NumberFormat = "###"
-    Next c
-End Sub
-
-Sub DelAllPercentage(ByRef r As Range)
-    Dim c As Range
-    Dim s_in As String
-    Dim s_out As String
-    Dim spaceIdx As Integer
-    
-    For Each c In r
-        s_in = c.Value2
-        s_in = Left(s_in, InStr(s_in, "(") - 2)
-        If Len(s_in) > 4 Then
-            s_out = Left(s_in, Len(s_in) - 4) + Right(s_in, 3)
-        Else
-            s_out = s_in
-        End If
-        c = s_out
-        c.NumberFormat = "###"
-    Next c
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Digit2String
->>>>>>
-Attribute VB_Name = "Digit2String"
-Sub main()
-
-Dim dd As Double
-Dim st As String
-
-dd = 21.2234
-
-' 0 - rub
-' 1 - y.e.
-
-st = Digit2String(dd, 1)
-
-End Sub
-
-Function Digit2String(digit As Double, p As Integer) As String
-
-' ������ ������� 18.06.01 mikle-2
-Dim W1(20) As String
-Dim W1a(20) As String
-Dim W10(10) As String
-Dim W100(10) As String
-Dim W1000(10) As String
-
-W1(0) = ""
-W1(1) = "����"
-W1(2) = "���"
-W1(3) = "���"
-W1(4) = "������"
-W1(5) = "����"
-W1(6) = "�����"
-W1(7) = "����"
-W1(8) = "������"
-W1(9) = "������"
-W1(10) = "������"
-W1(11) = "����������"
-W1(12) = "����������"
-W1(13) = "����������"
-W1(14) = "������������"
-W1(15) = "����������"
-W1(16) = "�����������"
-W1(17) = "����������"
-W1(18) = "������������"
-W1(19) = "������������"
-W1a(0) = ""
-W1a(1) = "����"
-W1a(2) = "���"
-W1a(3) = "���"
-W1a(4) = "������"
-W1a(5) = "����"
-W1a(6) = "�����"
-W1a(7) = "����"
-W1a(8) = "������"
-W1a(9) = "������"
-W1a(10) = "������"
-W1a(11) = "����������"
-W1a(12) = "����������"
-W1a(13) = "����������"
-W1a(14) = "������������"
-W1a(15) = "����������"
-W1a(16) = "�����������"
-W1a(17) = "����������"
-W1a(18) = "������������"
-W1a(19) = "������������"
-W10(0) = ""
-W10(1) = "������"
-W10(2) = "��������"
-W10(3) = "��������"
-W10(4) = "�����"
-W10(5) = "���������"
-W10(6) = "����������"
-W10(7) = "���������"
-W10(8) = "�����������"
-W10(9) = "���������"
-W100(0) = ""
-W100(1) = "���"
-W100(2) = "������"
-W100(3) = "������"
-W100(4) = "���������"
-W100(5) = "�������"
-W100(6) = "��������"
-W100(7) = "�������"
-W100(8) = "���������"
-W100(9) = "���������"
-
-Result = ""
-
-e = Int((digit - Int(digit)) * 100) ' decimal
-digit_long = Int(digit)
-a = Int(digit_long / 1000000) '32123456/1000000 = 32 -> 10^6
-b = digit_long - (a * 1000000) '32123456-32000000 = 123456
-c = Int(b / 1000) '123456/1000 = 123 -> 10^3
-d = b - (c * 1000) '123456-123*1000 = 456 -> 1
-
-Add = ""
-For i = 2 To 0 Step -1
-    m = Int(a / (10 ^ i))
-    If i = 2 Then
-        If m <> 0 Then
-            R = W100(m) + " "
-            Add = "��������� "
-        End If
-    End If
-    If i = 1 Then
-        If m <> 0 Then
-            If a < 20 Then
-                Result = Result + W1(a) + " ��������� "
-                GoTo con_0
-            End If
-            R = W10(m) + " "
-            Add = "��������� "
-        End If
-    End If
-    If i = 0 Then
-        If m <> 0 Then
-            If m >= 5 Then
-                R = W1(m) + " "
-                Add = "��������� "
-            End If
-            If m <= 4 Then
-                R = W1(m) + " "
-                Add = "�������� "
-            End If
-            If m = 1 Then
-                R = "���� "
-                Add = "������� "
-            End If
-        End If
-        
-    End If
-    a = a - (m * (10 ^ i))
-    Result = Result + R
-    R = ""
-Next i
-Result = Result + Add
-con_0:
-
-Add = ""
-For i = 2 To 0 Step -1
-    m = Int(c / (10 ^ i))
-    If i = 2 Then
-        If m <> 0 Then
-            R = W100(m) + " "
-            Add = "����� "
-        End If
-    End If
-    If i = 1 Then
-        If m <> 0 Then
-            If c < 20 Then
-                Result = Result + W1(c) + " ����� "
-                GoTo con_1
-            End If
-            R = W10(m) + " "
-            Add = "����� "
-        End If
-    End If
-    If i = 0 Then
-        If m <> 0 Then
-            If m >= 5 Then
-                R = W1(m) + " "
-                Add = "����� "
-            End If
-            If m <= 4 Then
-                R = W1(m) + " "
-                Add = "������ "
-            End If
-            If m = 2 Then
-                R = "��� "
-                Add = "������ "
-            End If
-            If m = 1 Then
-                R = "���� "
-                Add = "������ "
-            End If
-        End If
-    End If
-    c = c - (m * (10 ^ i))
-    Result = Result + R
-    R = ""
-Next i
-Result = Result + Add
-con_1:
-
-Add = ""
-For i = 2 To 0 Step -1
-    m = Int(d / (10 ^ i))
-    If i = 2 Then
-        If m <> 0 Then
-            R = W100(m) + " "
-        End If
-    End If
-    If i = 1 Then
-        If m <> 0 Then
-            If d < 20 Then
-                R = W1(d) + " "
-                Result = Result + R
-                GoTo con_2
-            End If
-            R = W10(m) + " "
-        End If
-    End If
-    If i = 0 Then
-        If m <> 0 Then
-            If p = 0 Then
-                R = W1(m) + " "
-            Else
-                R = W1a(m) + " "
-            End If
-        End If
-    End If
-    
-    d = d - (m * (10 ^ i))
-    Result = Result + R
-    R = ""
-Next i
-con_2:
-
-
-If p = 0 Then       ' rub
-    Result = Result + "���. "
-End If
-
-For i = 1 To 0 Step -1
-    m = Int(e / (10 ^ i))
-    Result = Result + Chr$(m + Asc("0"))
-    e = e - (m * (10 ^ i))
-Next i
-
-If p = 0 Then       ' rub
-    Result = Result + " ���."
-Else                ' y.e.
-    Result = Result + "/100 �.�"
-End If
-
-Result(1) = Result(1) + Chr(Asc("A")) - Chr(Asc("a"))
-
-Digit2String = Result
-
-End Function
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Forecast()
-Attribute Forecast.VB_Description = "Macro recorded 06.12.2002 by nick"
-Attribute Forecast.VB_ProcData.VB_Invoke_Func = "f\n14"
-    With Selection
-        .Cells(1, 2).GoalSeek Goal:=1746, ChangingCell:=.Cells(1, 1)
-    End With
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub RandFill()
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ListFunc
->>>>>>
-Attribute VB_Name = "ListFunc"
-Option Explicit
-
-Function getEqClass(r As Range, ClRange As Range) As Integer
-    Dim i As Integer
-    For i = 1 To ClRange.Count
-        If r < ClRange.Cells(i) Then
-            getEqClass = i
-            Exit Function
-        End If
-    Next i
-End Function
-
-Function getClassLetter(Idx As Integer, ClNames As Range) As String
-    getClassLetter = ClNames.Cells(Idx)
-End Function
-
-Function GetEqLetter(r As Range, ClRange As Range, ClNames As Range) As String
-    GetEqLetter = getClassLetter(getEqClass(r, ClRange), ClNames)
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag lengthProject Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    Call CleanUp
-End Sub
-
-Private Sub Workbook_Open()
-    Call CreateFormBar
-    frmFaceID.Show
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-'Global variables hold preious choices
-'for begining and ending FaceID numbers
-Public glbLastFirstID As Long
-Public glbLastLastID As Long
-
-
-Function CBShowButtonFaceIDs(lngIDStart As Long, _
-                             lngIDStop As Long)
-    ' This procedure creates a toolbar with buttons that display the
-    ' images associated with the values starting at lngIDStart and
-    ' ending at lngIDStop.
-    
-    Dim cbrNewToolbar   As CommandBar
-    Dim cmdNewButton    As CommandBarButton
-    Dim intCntr         As Integer
-    
-    ' Delete existing ShowFaceIds toolbar if it exists.
-    On Error Resume Next
-    Application.CommandBars("ShowFaceIds").Delete
-    frmFaceID.MousePointer = fmMousePointerHourGlass
-    ' Create a new toolbar.
-    Set cbrNewToolbar = Application.CommandBars.Add _
-        (Name:="ShowFaceIds", temporary:=True)
-    
-    ' Create a new button with an image matching the FaceId property value
-    ' indicated by intCntr.
-    For intCntr = lngIDStart To lngIDStop
-        Set cmdNewButton = cbrNewToolbar.Controls.Add(Type:=msoControlButton)
-        With cmdNewButton
-            ' Setting the FaceId property value specifies the appearance
-            ' but not the functionality of the button.
-            .FaceId = intCntr
-            .Caption = "FaceId = " & intCntr
-        End With
-    Next intCntr
-    
-    ' Show the images on the toolbar.
-    With cbrNewToolbar
-        .Width = 600
-        .Left = 100
-        .Top = 200
-        .Visible = True
-    End With
-    frmFaceID.MousePointer = fmMousePointerDefault
-End Function
-
-
-
-Public Function Validate()
-Dim lngTempNumber As Long
-
-'Procedure to check data entered by user
-With frmFaceID
-'If the first number requested < last number
-'then reverse them and rationalize
-'display next time form opens
-    If .txtFirstID Or .txtLastID > 0 Then
-        If CLng(.txtFirstID) > CLng(.txtLastID) Then
-           lngTempNumber = .txtFirstID
-           .txtFirstID = .txtLastID
-           .txtLastID = lngTempNumber
-         glbLastFirstID = .txtFirstID
-         glbLastLastID = .txtLastID
-        End If
- 'Only allow 200 FaceIDs per operation
- 'Call procedure to create FaceID values
- 'Take form out of memory
- 
-        If (.txtLastID - .txtFirstID) <= 200 Then
-            Call CBShowButtonFaceIDs(.txtFirstID, .txtLastID)
-            Unload frmFaceID
-        Else
-            MsgBox "Please request less than 200 FaceID's ", , "FaceID Number Finder"
-        End If
-    Else
-            .txtFirstID.SetFocus
-    End If
-End With
-End Function
-
-Public Function CleanUp()
-    On Error Resume Next
-   
-    Application.CommandBars("ShowFaceIds").Delete
-    Application.CommandBars("ShowForm").Delete
-      
-        
-End Function
-
-Public Function CreateFormBar()
-    Dim cmdBar As CommandBar
-    Dim btnForm As CommandBarButton
-'Delete the object if it already exists
-    On Error Resume Next
-    Application.CommandBars("ShowForm").Delete
-'Set the commandbar object variable
-    Set cmdBar = Application.CommandBars.Add
-        cmdBar.Name = "ShowForm"
-'Add a button
-    With cmdBar.Controls
-        
-        Set btnForm = .Add(msoControlButton)
-        
-    End With
-'Set the new button's properties
-    With btnForm
-        .Style = msoButtonIconAndCaption
-        .Caption = "Show FaceId Finder Form"
-        .FaceId = 2104
-        .OnAction = "OpenForm"
-        .TooltipText = "Show FaceID Form"
-    End With
-  ' Made visible in the form terminate event
-
-End Function
-
-Public Function OpenForm()
-'OnAction event procedure of ShowForm toolbar
-    frmFaceID.Show
-End Function
-
-
-<<<<<<
-======================
-frmFaceID
->>>>>>
-Attribute VB_Name = "frmFaceID"
-Attribute VB_Base = "0{5F1D3654-0CF0-11D2-B619-00AA00BBB974}{5F1D3641-0CF0-11D2-B619-00AA00BBB974}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub cmdFaceId_Click()
-  
-  Dim strDefaultStatus As String
- 'Set up global variables with current requested values
-    glbLastFirstID = txtFirstID
-    glbLastLastID = txtLastID
- 'Detect current status bar value
- 'Set status bar message while FaceId's are generated
-    strDefaultStatus = Application.DisplayStatusBar
-    Application.DisplayStatusBar = True
-    Application.StatusBar = "Working on FaceID display please wait"
-    
-'Call validation procedure
-   
-    Call Validate
- 'Put Status bar back as it was
-    Application.DisplayStatusBar = False
-    Application.StatusBar = strDefaultStatus
-End Sub
-
-
-Private Sub txtFirstID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
-   'Test for non numeric entry then cancel or convert to long
-    If IsNumeric(txtFirstID) = False Then
-       txtFirstID = ""
-       Cancel = True
-    Else
-        txtFirstID = CLng(txtFirstID)
-    End If
-    
-End Sub
-
-
-Private Sub txtLastID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
-    'Test for non numeric entry then cancel or convert to long
-    If IsNumeric(txtLastID) = False Then
-       txtLastID = ""
-       Cancel = True
-    Else
-        txtLastID = CLng(txtLastID)
-    End If
-    
-End Sub
-
-Private Sub UserForm_Activate()
- 'Set up form with last requested values
- 'Make toolbar not visible
- On Error Resume Next
-    txtFirstID = glbLastFirstID
-    txtLastID = glbLastLastID
-    Application.CommandBars("ShowForm").Visible = False
-End Sub
-
-
-
-Private Sub UserForm_Terminate()
-    'Show toolbar if form is unloaded in
-    'Validate procedure of if X is clicked
-    Application.CommandBars("ShowForm").Visible = True
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Function GetRegion(idx As Integer) As String
-    GetRegion = Range("LST_REGIONS").Offset(i, 0)
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Workbook_Activate()
-    Worksheets("Home").Select
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("C4:G30").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("D44:H59").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-PPExport
->>>>>>
-Attribute VB_Name = "PPExport"
-Option Explicit
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub ViewReport()
-    Dim ReportDoc As PowerPoint.Presentation
-    Set ReportDoc = GetObject(GetWBPath(ThisWorkbook.FullName) + "report.ppt")
-    ReportDoc.Application.Visible = True
-End Sub
-
-Sub CreateReportSlide(ReportDoc As PowerPoint.Presentation, Title As String)
-    Dim ReportPage As PowerPoint.Slide
-    
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.Count + 1, ppLayoutBlank)
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = Title
-End Sub
-
-Sub CreateReport()
-    Dim ReportApp As PowerPoint.Application
-    Dim ReportDoc As PowerPoint.Presentation
-    
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    Set ReportDoc = ReportApp.Presentations.Add
-    
-    Dim i As Integer
-    For i = 1 To 4
-        ThisWorkbook.Worksheets("Sheet" + Format(i)).ExportCopy
-        CreateReportSlide ReportDoc, "Create slide name #" + Format(i)
-    Next i
-    
-    ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + "report"
-    ReportApp.Quit
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Workbook_Activate()
-    Worksheets("Home").Select
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("C4:G30").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("D44:H59").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-PPExport
->>>>>>
-Attribute VB_Name = "PPExport"
-Option Explicit
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub ViewReport()
-    Dim ReportDoc As PowerPoint.Presentation
-    Set ReportDoc = GetObject(GetWBPath(ThisWorkbook.FullName) + "report.ppt")
-    ReportDoc.Application.Visible = True
-End Sub
-
-Sub CreateReportSlide(ReportDoc As PowerPoint.Presentation, Title As String)
-    Dim ReportPage As PowerPoint.Slide
-    
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.Count + 1, ppLayoutBlank)
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = Title
-End Sub
-
-Sub CreateReport()
-    Dim ReportApp As PowerPoint.Application
-    Dim ReportDoc As PowerPoint.Presentation
-    
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    Set ReportDoc = ReportApp.Presentations.Add
-    
-    Dim i As Integer
-    For i = 1 To 4
-        ThisWorkbook.Worksheets("Sheet" + Format(i)).ExportCopy
-        CreateReportSlide ReportDoc, "Create slide name #" + Format(i)
-    Next i
-    
-    ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + "report"
-    ReportApp.Quit
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'Telfast_marketing'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    Dim res
-    res = MsgBox( _
-        prompt:="�� ������� ��������� ���������? �� ������ ��?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If res <> vbYes Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    
-    Dim NewFileName, DefFileName, WBPath As String
-    NewFileName = MakeNewFileName( _
-                        Worksheets("home").Range("USER_NAME_F"), _
-                        Worksheets("home").Range("USER_NAME_S"), _
-                        Worksheets("data").Range("CITY_TABLES") _
-                        .Offset( _
-                            Worksheets("data").Range("IDX_CITY"), _
-                            (Worksheets("data").Range("IDX_REGION") - 1) * 2 _
-                        ) _
-                    )
-    DefFileName = MakeNewFileName( _
-                        DEF_USER_NAME_F, _
-                        DEF_USER_NAME_S, _
-                        Worksheets("data").Range("CITY_TABLES") _
-                        .Offset(DEF_IDX_CITY, (DEF_IDX_REGION - 1) * 2) _
-                    )
-    WBPath = GetWBPath(ThisWorkbook.FullName)
-    
-    If ThisWorkbook.Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            If NewFileName <> DefFileName Then
-                dlgFname.Caption = PROGRAM_NAME
-                dlgFname.lbFName = NewFileName
-                dlgFname.lbFPath = WBPath
-                dlgFname.Show
-                NewFileName = WBPath & NewFileName
-                ThisWorkbook.SaveAs FileName:=NewFileName
-            Else
-                ThisWorkbook.Save
-            End If
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(HOME_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 1
-    Case INP_TXT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-
-    If is_InputRange(Target) <> INP_NO Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    Dim test As Boolean
-    
-    is_InputRange = INP_NO
-    
-    If r.Column = Range("USER_NAME_F").Column Then
-        test = r.Row = Range("USER_NAME_S").Row _
-                        Or r.Row = Range("USER_NAME_F").Row
-        If test Then
-            is_InputRange = INP_TXT
-        End If
-    Else
-        If r.Column = Range("USER_PLAN").Column Then
-            test = r.Row = Range("USER_PLAN").Row _
-                            Or r.Row = Range("USER_FACT").Row _
-                            Or r.Row = Range("USER_BUDGET").Row _
-                            Or r.Row = Range("USER_SVNORM").Row
-            
-            Dim idx As Integer
-            idx = Worksheets(DATA_SHEET).Range("IDX_PERSONE")
-            
-            If test Then
-                is_InputRange = INP_NUM
-            Else
-                If r.Row = Range("USER_STAF").Row Then
-                    If idx = 1 Then
-                        is_InputRange = INP_NUM
-                    End If
-                End If
-            End If
-        End If
-    End If
-End Function
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC As String = "C9"
-Const INP_APT As String = "C11"
-Const INP_ADV As String = "C13"
-Const INP_ACT As String = "C15"
-Const INP_VIP As String = "C17"
-Const INP_SUM As String = "C19"
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    
-    If is_InputRange(Target) Then
-        GoalSeekNow Range(INP_SUM), Target
-    Else
-        If Target.Row = Range(INP_SUM).Row And Target.Column = Range(INP_SUM).Column Then
-            Dim Addr As String
-            
-            Addr = INP_DOC & "," & INP_APT & "," & INP_ADV & "," & INP_ACT & "," & INP_VIP
-            RangeNormalize Range(Addr), Target
-            
-        End If
-    End If
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.2
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range(INP_DOC).Column _
-                And ( _
-                    r.Row = Range(INP_DOC).Row _
-                    Or r.Row = Range(INP_APT).Row _
-                    Or r.Row = Range(INP_ADV).Row _
-                    Or r.Row = Range(INP_ACT).Row _
-                    Or r.Row = Range(INP_VIP).Row _
-                )
-End Function
-
-
-<<<<<<
-======================
-mHome
->>>>>>
-Attribute VB_Name = "mHome"
-Option Explicit
-
-Sub cboxPersone_Change()
-    With ThisWorkbook.Worksheets(HOME_SHEET)
-        Dim r As Range
-        Range("A1").Select
-        If .Shapes("cboxPersone").ControlFormat.ListIndex = 2 Then
-            .Unprotect
-            .Range("G15") = 1
-            If Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-                .Protect
-            End If
-        End If
-    End With
-End Sub
-
-Sub cboxArea_Change()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    With ThisWorkbook.Worksheets(DATA_SHEET)
-        GroupIdx = .Range("IDX_REGION")
-        .Range("IDX_CITY") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        NewSumRange = .Name & "!" & .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).Address
-    End With
-    With ThisWorkbook.Worksheets(HOME_SHEET)
-        .Shapes("cboxCity").ControlFormat.ListFillRange = NewCbxRange
-        .Unprotect
-        .Range("G10").Formula = "=sum(" & NewSumRange & ")"
-        If Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-            .Protect
-        End If
-    End With
-End Sub
-
-Sub cboxCity_Change()
-    
-End Sub
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-
-Sub btHome_Click()
-    Worksheets(HOME_SHEET).Select
-    Worksheets(DATA_SHEET).Range("CUR_STATE") = 0
-End Sub
-
-Sub bt2Budget_Click()
-    Sheets("budget").Select
-End Sub
-
-
-Sub btBdgtPrev_Click()
-    btHome_Click
-End Sub
-
-Sub btBdgtNext_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Final").Select
-    End If
-End Sub
-
-Sub btDoc_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Doc").Select
-    End If
-End Sub
-
-Sub btDocVisit_Click()
-    Sheets("Doc.Visit").Select
-End Sub
-
-Sub btDocConf_Click()
-    Sheets("Doc.Conf").Select
-End Sub
-
-Sub btApt_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Apt").Select
-    End If
-End Sub
-
-Sub btAptVisit_Click()
-    Sheets("Apt.Visit").Select
-End Sub
-
-
-Sub btAptConf_Click()
-    Sheets("Apt.Conf").Select
-End Sub
-
-Sub btAdv_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Adv").Select
-    End If
-End Sub
-
-Sub btAdvPrev_Click()
-    If check_Adv Then
-        bt2Budget_Click
-    End If
-End Sub
-
-Sub btAct_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Act").Select
-    End If
-End Sub
-
-Sub btCost_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Cost").Select
-    End If
-End Sub
-
-Sub btCostPrev_Click()
-    If check_budget(Range("Cost!C17")) Then
-        Sheets("budget").Select
-    End If
-End Sub
-
-<<<<<<
-======================
-Sheet40
->>>>>>
-Attribute VB_Name = "Sheet40"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.7
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range("C9").Column _
-                    And r.Row = Range("C9").Row
-End Function
-
-
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub test()
-    Dim str As String
-    str = GetWBPath(ThisWorkbook.FullName)
-End Sub
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-Attribute SetDesignFlagOn.VB_ProcData.VB_Invoke_Func = "E\n14"
-    Dim Sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each Sh In Worksheets
-        Sh.Unprotect
-        Sh.Visible = xlSheetVisible
-    Next Sh
-    Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-Attribute SetDesignFlagOff.VB_ProcData.VB_Invoke_Func = " \n14"
-    Application.ScreenUpdating = False
-    Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim Sh As Worksheet
-    For Each Sh In Worksheets
-        If Sh.Name <> "data" Then
-            Sh.Protect
-        Else
-            Sh.Visible = xlSheetVeryHidden
-        End If
-    Next Sh
-    Application.ScreenUpdating = True
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma training"
-Public Const PROGRAM_VERSION As String = "version 1.0"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "N35"
-Public Const CITY_TABLES As String = "N30"
-
-
-Public Const DATA_SHEET As String = "data"
-
-' �������� ����� Home
-Public Const DEF_USER_NAME_F As String = "����"
-Public Const DEF_USER_NAME_S As String = "��������"
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Public Const HOME_SHEET As String = "Home"
-Public Const USER_NAME_F As String = "USER_NAME_F"
-Public Const USER_NAME_S As String = "USER_NAME_S"
-Public Const USER_PLAN As String = "USER_PLAN"
-Public Const USER_BUDGET As String = "USER_BUDGET"
-Public Const USER_FACT As String = "USER_FACT"
-
-' �������� ����� Adv
-Public Const ADV_SHEET As String = "Adv"
-Public Const ADV_SUM_CAP As String = "K9"
-Public Const ADV_SUM_DOC As String = "C17"
-Public Const ADV_SUM_APT As String = "E17"
-Public Const ADV_SUM_CAST As String = "G17"
-Public Const ADV_SUM_DIST As String = "I17"
-
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{81B9D41B-89F6-4B17-9F1D-45017FFC6C8F}{EF972C75-B6C6-407C-BAF6-74472541F2BB}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{0D5199B4-A753-4F74-A564-40388FABC4B0}{19DC56E2-E0F4-44B4-8B23-51B77A2564D5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-Sheet52
->>>>>>
-Attribute VB_Name = "Sheet52"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTDATE_LT As String = "B11"
-Const INPUTDATE_RB As String = "B25"
-Const INPUTTEXT_LT As String = "C11"
-Const INPUTTEXT_RB As String = "C25"
-Const INPUTNUMB_LT As String = "F11"
-Const INPUTNUMB_RB As String = "I25"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("B11").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTDATE_LT), Range(INPUTDATE_RB)) Then
-        is_InputRange = INP_DAT
-    Else
-        If is_InputArea(r, Range(INPUTTEXT_LT), Range(INPUTTEXT_RB)) Then
-            is_InputRange = INP_TXT
-        Else
-            If is_InputArea(r, Range(INPUTNUMB_LT), Range(INPUTNUMB_RB)) Then
-                    is_InputRange = INP_NUM
-            Else
-                is_InputRange = INP_NO
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Function check_Adv() As Boolean
-    Dim b As Boolean
-    b = Abs(Range(ADV_SUM_CAP) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_DOC) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_APT) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_CAST) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_DIST) - 1) < 0.0001 _
-        Or Range("D13") = 0
-    If Not b Then
-        MsgBox "�� ��������� ��������� ������. �������� ����� ������ ���� = 100%"
-    End If
-    check_Adv = b
-End Function
-
-Function check_budget(r As Range) As Boolean
-    Dim f As Double
-    Dim b As Boolean
-    f = r
-    b = Abs(f - 1#) < 0.0001
-    If Not b Then
-        MsgBox "�� ��������� ��������� ������. �������� ����� ������ ���� = 100%"
-    End If
-    check_budget = b
-End Function
-
-Sub RangeNormalize(Src As Range, Dst As Range)
-    Dim f As Double
-    Dim c As Range
-    f = Dst
-    If f <> 0 Then
-        Src.Worksheet.Unprotect
-        For Each c In Src
-            c = c / f
-        Next c
-        If Not Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-            Src.Worksheet.Protect
-        End If
-    Else
-        MsgBox "������� ���� �� ���� �����!"
-    End If
-End Sub
-
-Sub GoalSeekNow(Goal As Range, Target As Range)
-    Dim diff As Double
-    
-    diff = Goal - 1
-    If Abs(diff) > 0.0001 Then
-        If (diff > 0 And diff < Target) Or (diff < 0 And 1 - Target > Abs(diff)) Then
-            Goal.GoalSeek Goal:=1, ChangingCell:=Range(Target.Address)
-        Else
-            MsgBox "���������� �������� �� ��������. �������� ������ ��������!"
-        End If
-    End If
-
-End Sub
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100."
-    End If
-End Sub
-
-Sub Check_Number(Target As Range, Def_Val As Double)
-    Dim test As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                test = True
-            End If
-        End If
-    Next r
-    
-    If test Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!"
-    End If
-    
-End Sub
-
-Function is_InputArea(r As Range, LT As Range, RB As Range) As Boolean
-    is_InputArea = r.Column >= LT.Column _
-                And r.Row >= LT.Row _
-                And r.Column <= RB.Column _
-                And r.Row <= RB.Row
-End Function
-
-<<<<<<
-======================
-Sheet70
->>>>>>
-Attribute VB_Name = "Sheet70"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_NUM_1_LT As String = "E14"
-Const INP_NUM_1_RB As String = "J14"
-Const INP_NUM_2_LT As String = "E16"
-Const INP_NUM_2_RB As String = "J16"
-Const INP_NUM_3_LT As String = "E18"
-Const INP_NUM_3_RB As String = "J18"
-Const INP_NUM_4_LT As String = "E20"
-Const INP_NUM_4_RB As String = "J20"
-Const INP_NUM_5_LT As String = "E22"
-Const INP_NUM_5_RB As String = "J22"
-
-Const INP_DAT_1_LT As String = "B14"
-Const INP_DAT_1_RB As String = "C14"
-Const INP_DAT_2_LT As String = "B16"
-Const INP_DAT_2_RB As String = "C16"
-Const INP_DAT_3_LT As String = "B18"
-Const INP_DAT_3_RB As String = "C18"
-Const INP_DAT_4_LT As String = "B20"
-Const INP_DAT_4_RB As String = "C20"
-Const INP_DAT_5_LT As String = "B22"
-Const INP_DAT_5_RB As String = "C22"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("B14").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) <> INP_NO Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Integer
-    Dim test As Boolean
-    
-    test = is_InputArea(r, Range(INP_NUM_1_LT), Range(INP_NUM_1_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_2_LT), Range(INP_NUM_2_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_3_LT), Range(INP_NUM_3_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_4_LT), Range(INP_NUM_4_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_5_LT), Range(INP_NUM_5_RB))
-    If test Then
-       is_InputRange = INP_NUM
-    Else
-        test = is_InputArea(r, Range(INP_DAT_1_LT), Range(INP_DAT_1_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_2_LT), Range(INP_DAT_2_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_3_LT), Range(INP_DAT_3_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_4_LT), Range(INP_DAT_4_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_5_LT), Range(INP_DAT_5_RB))
-        If test Then
-            is_InputRange = INP_DAT
-        Else
-            is_InputRange = INP_NO
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-Sheet30
->>>>>>
-Attribute VB_Name = "Sheet30"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet41
->>>>>>
-Attribute VB_Name = "Sheet41"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const MEMBERSHIP As String = "D7"
-Const MILEAGE As String = "D9"
-Const INPUTAREA_LT As String = "C17"
-Const INPUTAREA_RB As String = "E24"
-
-Const ChangeCheckFlag As Boolean = False
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C17").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-        Case 1
-            Check_Number Target, 1
-        Case 2
-            Check_Number Target, 15
-        Case 3
-            Check_Number Target, 50
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If r.Column = Range(MEMBERSHIP).Column And r.Row = Range(MEMBERSHIP).Row Then
-        is_InputRange = 1
-    Else
-        If r.Column = Range(MILEAGE).Column And r.Row = Range(MILEAGE).Row Then
-            is_InputRange = 2
-        Else
-            If r.Column >= Range(INPUTAREA_LT).Column _
-                And r.Row >= Range(INPUTAREA_LT).Row _
-                And r.Column <= Range(INPUTAREA_RB).Column _
-                And r.Row <= Range(INPUTAREA_RB).Row Then
-                    is_InputRange = 3
-            Else
-                is_InputRange = 0
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet42
->>>>>>
-Attribute VB_Name = "Sheet42"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTDATE_LT As String = "B11"
-Const INPUTDATE_RB As String = "B25"
-Const INPUTTEXT_LT As String = "C11"
-Const INPUTTEXT_RB As String = "C25"
-Const INPUTNUMB_LT As String = "F11"
-Const INPUTNUMB_RB As String = "I25"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range(INPUTDATE_LT).Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTDATE_LT), Range(INPUTDATE_RB)) Then
-        is_InputRange = INP_DAT
-    Else
-        If is_InputArea(r, Range(INPUTTEXT_LT), Range(INPUTTEXT_RB)) Then
-            is_InputRange = INP_TXT
-        Else
-            If is_InputArea(r, Range(INPUTNUMB_LT), Range(INPUTNUMB_RB)) Then
-                    is_InputRange = INP_NUM
-            Else
-                is_InputRange = INP_NO
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet60
->>>>>>
-Attribute VB_Name = "Sheet60"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC_LT As String = "C10"
-Const INP_DOC_RB As String = "C16"
-Const INP_APT_LT As String = "E10"
-Const INP_APT_RB As String = "E16"
-Const INP_CAST_LT As String = "G10"
-Const INP_CAST_RB As String = "G16"
-Const INP_DIST_LT As String = "I10"
-Const INP_DIST_RB As String = "I16"
-Const CAP_DOC As String = "C9"
-Const CAP_APT As String = "E9"
-Const CAP_CAST As String = "G9"
-Const CAP_DIST As String = "I9"
-
-
-Const INP_NO As Integer = 0
-Const INP_CAP As Integer = 1
-Const INP_DOC As Integer = 2
-Const INP_APT As Integer = 3
-Const INP_CAST As Integer = 4
-Const INP_DIST As Integer = 5
-
-Const INP_SUM_CAP As Integer = 11
-Const INP_SUM_DOC As Integer = 12
-Const INP_SUM_APT As Integer = 13
-Const INP_SUM_CAST As Integer = 14
-Const INP_SUM_DIST As Integer = 15
-
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim Inp As Integer
-    Dim Addr As String
-    Inp = is_InputRange(Target)
-    Select Case is_InputRange(Target)
-        Case INP_NO
-            Cancel = False
-        
-        Case INP_CAP
-            GoalSeekNow Range(ADV_SUM_CAP), Target
-        
-        Case INP_DOC
-            GoalSeekNow Range(ADV_SUM_DOC), Target
-        
-        Case INP_APT
-            GoalSeekNow Range(ADV_SUM_APT), Target
-        
-        Case INP_CAST
-            GoalSeekNow Range(ADV_SUM_CAST), Target
-        
-        Case INP_DIST
-            GoalSeekNow Range(ADV_SUM_DIST), Target
-        
-        Case INP_SUM_CAP
-            Addr = CAP_DOC & "," & CAP_APT & "," & CAP_CAST & "," & CAP_DIST
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_DOC
-            Addr = INP_DOC_LT & ":" & INP_DOC_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_APT
-            Addr = INP_APT_LT & ":" & INP_APT_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_CAST
-            Addr = INP_CAST_LT & ":" & INP_CAST_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_DIST
-            Addr = INP_DIST_LT & ":" & INP_DIST_RB
-            RangeNormalize Range(Addr), Target
-    End Select
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_CAP
-        Check_Percent Target, 0.25
-    Case INP_DOC, INP_APT, INP_CAST, INP_DIST
-        Check_Percent Target, 0.15
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) > 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Integer
-    is_InputRange = INP_NO
-    If r.Row = Range(CAP_DOC).Row Then
-        If r.Column = Range(CAP_DOC).Column _
-                Or r.Column = Range(CAP_APT).Column _
-                Or r.Column = Range(CAP_CAST).Column _
-                Or r.Column = Range(CAP_DIST).Column Then
-            is_InputRange = INP_CAP
-        End If
-        If r.Column = Range(ADV_SUM_CAP).Column Then
-            is_InputRange = INP_SUM_CAP
-        End If
-    Else
-        If is_InputArea(r, Range(INP_DOC_LT), Range(INP_DOC_RB)) Then
-            is_InputRange = INP_DOC
-        Else
-            If is_InputArea(r, Range(INP_APT_LT), Range(INP_APT_RB)) Then
-                is_InputRange = INP_APT
-            Else
-                If is_InputArea(r, Range(INP_CAST_LT), Range(INP_CAST_RB)) Then
-                    is_InputRange = INP_CAST
-                Else
-                    If is_InputArea(r, Range(INP_DIST_LT), Range(INP_DIST_RB)) Then
-                        is_InputRange = INP_DIST
-                    Else
-                        If r.Row = Range(ADV_SUM_DOC).Row Then
-                            If r.Column = Range(ADV_SUM_DOC).Column Then
-                                is_InputRange = INP_SUM_DOC
-                            End If
-                            If r.Column = Range(ADV_SUM_APT).Column Then
-                                is_InputRange = INP_SUM_APT
-                            End If
-                            If r.Column = Range(ADV_SUM_APT).Column Then
-                                is_InputRange = INP_SUM_APT
-                            End If
-                            If r.Column = Range(ADV_SUM_CAST).Column Then
-                                is_InputRange = INP_SUM_CAST
-                            End If
-                            If r.Column = Range(ADV_SUM_DIST).Column Then
-                                is_InputRange = INP_SUM_DIST
-                            End If
-                        End If
-                    End If
-                End If
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet50
->>>>>>
-Attribute VB_Name = "Sheet50"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.7
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range("C9").Column _
-                    And r.Row = Range("C9").Row
-End Function
-
-
-<<<<<<
-======================
-Sheet51
->>>>>>
-Attribute VB_Name = "Sheet51"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTAREA_LT As String = "C17"
-Const INPUTAREA_RB As String = "E20"
-
-Const ChangeCheckFlag As Boolean = False
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C17").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) <> 0 Then
-        Check_Number Target, 50
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTAREA_LT), Range(INPUTAREA_RB)) Then
-        is_InputRange = 3
-    Else
-        is_InputRange = 0
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet80
->>>>>>
-Attribute VB_Name = "Sheet80"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC As String = "C9"
-Const INP_APT As String = "C11"
-Const INP_CUST As String = "C13"
-Const INP_DIST As String = "C15"
-Const INP_SUM As String = "C17"
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    
-    If is_InputRange(Target) Then
-        GoalSeekNow Range(INP_SUM), Target
-    Else
-        If Target.Row = Range(INP_SUM).Row And Target.Column = Range(INP_SUM).Column Then
-            Dim Addr As String
-            
-            Addr = INP_DOC & "," & INP_APT & "," & INP_CUST & "," & INP_DIST
-            RangeNormalize Range(Addr), Target
-            
-        End If
-    End If
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.25
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range(INP_DOC).Column _
-                And ( _
-                    r.Row = Range(INP_DOC).Row _
-                    Or r.Row = Range(INP_APT).Row _
-                    Or r.Row = Range(INP_CUST).Row _
-                    Or r.Row = Range(INP_DIST).Row _
-                )
-End Function
-
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-'                With .Controls
-'                    With .Add(msoControlButton)
-'                        .Caption = "&Contents"
-'                        .Style = msoButtonIconAndCaption
-'                        .FaceId = 49
-'                        .OnAction = "cmHelpContents"
-'                    End With
-'                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Telfast.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-    ThisWorkbook.Worksheets("home").Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-    Else
-        cmSetStandaloneMode
-    End If
-    ThisWorkbook.Worksheets("home").Select
-End Sub
-
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.Count > 1 Then
-        wbname = Wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            Wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Telfast bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(HOME_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(HOME_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{6B54EA33-E5D1-44C0-BC3C-E5960329B246}{639FA6FC-FBAC-44B4-ACC5-7DAF95DA47F4}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    
-    dlgPrint.cbMainReport = True
-    dlgPrint.cbMainBudget = False
-    dlgPrint.cbSrcData = False
-    dlgPrint.cbAllSheets = False
-    
-    dlgPrint.Show
-    
-    If dlgPrint.Tag = vbCancel Then
-        Exit Sub
-    End If
-    
-    Dim PrnIdx As Integer
-    
-    With dlgPrint
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("home", "budget", "Final")
-    Case 1111
-        plist = Array("home", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("home")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-dlgFname
->>>>>>
-Attribute VB_Name = "dlgFname"
-Attribute VB_Base = "0{AB4D9ABD-F40E-4C39-8FE4-0625E69E5365}{2CC3E532-33AC-44D8-9195-34917AF21E8C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btOK_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Macro1()
-Attribute Macro1.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro1.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro1 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    Charts.Add
-    ActiveChart.ChartType = xlBubble
-    ActiveChart.SetSourceData Source:=Sheets("file1").Range("H2:J11"), PlotBy:= _
-        xlColumns
-    ActiveChart.Location Where:=xlLocationAsObject, Name:="file1"
-    With ActiveChart
-        .HasTitle = True
-        .ChartTitle.Characters.Text = "�������"
-        .Axes(xlCategory, xlPrimary).HasTitle = True
-        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "���� ��������"
-        .Axes(xlValue, xlPrimary).HasTitle = True
-        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "���������� �������"
-    End With
-    With ActiveChart.Axes(xlCategory)
-        .HasMajorGridlines = True
-        .HasMinorGridlines = False
-    End With
-    With ActiveChart.Axes(xlValue)
-        .HasMajorGridlines = True
-        .HasMinorGridlines = False
-    End With
-    ActiveChart.HasLegend = False
-    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
-    ActiveChart.SeriesCollection(1).Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(9).DataLabel.Select
-    Selection.Characters.Text = "8379 �1"
-    Selection.AutoScaleFont = False
-    With Selection.Characters(Start:=1, Length:=7).Font
-        .Name = "Arial"
-        .FontStyle = "�������"
-        .Size = 10
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveChart.Axes(xlValue).MajorGridlines.Select
-End Sub
-Sub Macro2()
-Attribute Macro2.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro2.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro2 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    Application.CutCopyMode = False
-    With ActiveChart.ChartGroups(1)
-        .VaryByCategories = True
-        .ShowNegativeBubbles = False
-        .SizeRepresents = xlSizeIsArea
-        .BubbleScale = 100
-    End With
-End Sub
-Sub Macro3()
-Attribute Macro3.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro3.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro3 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(6).DataLabel.Select
-    ActiveChart.Axes(xlValue).MajorGridlines.Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(6).DataLabel.Select
-    Selection.Characters.Text = "9847 �2"
-    Selection.AutoScaleFont = False
-    With Selection.Characters(Start:=1, Length:=7).Font
-        .Name = "Arial"
-        .FontStyle = "�������"
-        .Size = 12
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveChart.PlotArea.Select
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-    xlRestoreView
-End Sub
-
-Sub xlRestoreView()
-    Application.CommandBars("Standard").Visible = True
-    Application.CommandBars("Formatting").Visible = True
-    Application.DisplayFormulaBar = True
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'ClexanePM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    Application.ScreenUpdating = True
-'    CheckUser
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).update_history
-    Application.Calculate
-
-End Sub
-
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "QTR_SEL"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Worksheets(REP_QTR_SHEET).Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .setEnt_date (ent_date)
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).getEnt_date()
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public ppReport As New cPPReport
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[PM]"
-Public Const PROGRAM_VERSION As String = "Clexane[PM] ver 1.1"
-Public Const PROGRAM_FILENAME As String = "clexane-pm"
-Public Const PROGRAM_BACKUPNAME As String = "pm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "pm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "rm-ex*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-Public Const CHART_DEF_TITLE As String = "* * *"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20031207
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O41"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-Public Const PRJ_QTR_SHEET As String = "PRJ_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Function time_correct(end_date As Long, ByVal theDate As Date) As Boolean
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-    If end_date = NO_ESTIMATION_DATE Then
-        time_correct = True
-        Exit Function
-    End If
-    
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    
-    time_correct = CurDate <= end_date
-    
-End Function
-
-Sub EnableRun(end_date As Long)
-    If Not time_correct(end_date, Now) Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub t()
-    EnableRun ESTIMATION_DATE
-End Sub
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Sub OpenPPT()
-    ppReport.ReportView
-End Sub
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    SelectLPU_BDGT lpu_id, ent_date
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .setEnt_date (ent_date)
-            .Range("lpu_id") = lpu_id
-            .Range("REP_ID") = rep_id
-            .Range("RM_ID") = rm_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("RM_ID") = rm_id
-        .Range("REP_ID") = rep_id
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.Name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{32FB0F3D-6884-41DC-99DB-E2C55B2257C4}{DED79A66-DA60-4CCC-9003-082480235D55}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{0DC9E035-CE0A-49FF-85A2-A4EC5FF8FE96}{D54DDC8A-1EE2-4BB3-8B94-343B521AF098}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S15"
-
-Sub PrintCopy()
-    Range("B1:K21").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), Range("RM_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    objLPU = Get_LPU_Record(id, Range("RM_ID"))
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.Name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BFB4547C-96A7-4739-AA0A-CEF1E35E2BDC}{C3D618A3-9410-4BC7-9D93-3B049D361132}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.Name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-    sh.Range("ret_addr") = ""
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{9AAD262F-A6C4-4912-9C58-D7A2071181B8}{9470F4EB-DA9F-4584-9159-D09319548D21}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{A8FBEE9C-DE59-49DE-971D-07BC9C0E9BD2}{C712732B-D8E4-4C2D-8E78-AC90968E0CD7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hw_reset()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        MsgBox "2"
-        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-'    Dim cREGMAN As tREGMAN
-'    Dim idx As Integer
-'    Dim dlg_ui As UserInfo
-'
-'    Set dlg_ui = New UserInfo
-'
-'    cREGMAN = Get_REGMAN_Record()
-'
-'    With ThisWorkbook.Worksheets(REGS_SHEET)
-'        .Range("IDX_REGION") = cREGMAN.Region
-'        .Range("IDX_CITY") = cREGMAN.City
-'    End With
-'
-'    With dlg_ui
-'        .cbRegion = cREGMAN.Region
-'        .cbCity = cREGMAN.City
-'        .tbFName = cREGMAN.FirstName
-'        .tbLName = cREGMAN.LastName
-'    End With
-'
-'    dlg_ui.Show
-'    Worksheets(REGS_SHEET).Calculate
-'
-'    If dlg_ui.Tag = vbOK Then
-'        With cREGMAN
-'            .Region = dlg_ui.cbRegion.Value
-'            .City = dlg_ui.cbCity.Value
-'            .FirstName = dlg_ui.tbFName.Value
-'            .LastName = dlg_ui.tbLName.Value
-'        End With
-'        Set_REGMAN_Record cREGMAN
-'    Else
-'        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-'    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    rm_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String, rm_id As Long) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String, rm_id As Long) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .rm_id = rm_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    rm_id As Long
-    Name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long, rm_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long, rm_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.Name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.Name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.rm_id = dbRecordset("rm_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id " & _
-    "AND lpu.rep_id=" & rep_id & " AND lpu.rm_id=lpu_budget.rm_id AND lpu.rm_id=" & rm_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds, lpu.rm_id AS rm_id " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .Name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cdbRM
->>>>>>
-Attribute VB_Name = "cdbRM"
-Option Explicit
-
-Public Type tRMID_COMMON
-    rm As tREGMAN
-    rgcd_count As Integer
-    rgcd() As tREGION
-End Type
-
-Function Get_RM_CommonList_by_QTR(ByRef rmcd() As tRMID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_RM_CommonList_by_QTR = dbGet_RM_CommonList_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_RM_CommonList_by_QTR(dbConnection As Object, ByRef rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    ' �������� ������ RM-��
-    Dim count As Integer
-    count = db_get_All_RM_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    Dim i As Integer
-    For i = 1 To count
-        rmcd(i).rgcd_count = 1
-        ReDim rmcd(i).rgcd(1 To 1)
-        getREGION_by_QTR ent_date, rmcd(i).rgcd(1), rmcd(i).rm.rm_id
-    Next i
-    dbGet_RM_CommonList_by_QTR = count
-End Function
-
-Function db_get_All_RM_by_QTR(dbConnection As Object, rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    
-    Dim count_sql As String
-    Dim get_sql As String
-    Dim rs As Object
-    Dim RM_Count As Integer
-        
-    count_sql = "SELECT COUNT(*) AS RM_TOTAL FROM reg_man"
-    get_sql = "SELECT * FROM reg_man"
-    Set rs = CreateObject("ADODB.Recordset")
-    rs.Open count_sql, dbConnection
-    
-    If Not rs.BOF Then
-        RM_Count = rs("RM_TOTAL")
-    End If
-    
-    rs.Close
-    
-     db_get_All_RM_by_QTR = RM_Count
-    
-    If RM_Count > 0 Then
-        'we have records
-        ReDim rmcd(1 To RM_Count)
-        Dim index As Long
-        index = 1
-        rs.Open get_sql, dbConnection
-        
-        If Not rs.BOF Then
-             Do While Not rs.EOF
-                 Dim tmp_rmcd As tRMID_COMMON
-                 With tmp_rmcd
-                    .rgcd_count = 0
-                    .rm.City = rs("city")
-                    .rm.FirstName = rs("firstname")
-                    .rm.LastName = rs("lastname")
-                    .rm.rm_id = rs("mgr_id")
-                    .rm.Region = rs("region")
-                 End With
-                 
-                 rmcd(index) = tmp_rmcd
-                 index = index + 1
-                 rs.MoveNext
-             Loop
-        End If
-    End If
-    
-End Function
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-           With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub CreateExtCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom extendet commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Add New Slide"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 280
-                .OnAction = "cmAddSlide"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        Application.ScreenUpdating = False
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        Application.ScreenUpdating = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmNewReport()
-    ppReport.CreateReport
-    MsgBox "����� ����� ������", vbInformation + vbOKOnly, PROGRAM_NAME
-    CreateExtCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmOpenReport()
-    Dim fileToOpen
-    Dim s As String
-    fileToOpen = Application _
-        .GetOpenFileName("Report Files (*.ppt), *.ppt", title:="Report OPen", MultiSelect:=False)
-    If fileToOpen <> False Then
-        s = fileToOpen
-        ppReport.OpenReport s
-        CreateExtCommandBar theApp:=ThisWorkbook.Application
-    End If
-End Sub
-
-Sub cmCloseReport()
-    On Error Resume Next
-    ppReport.SaveReport
-    CreateCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmAddSlide()
-    ThisWorkbook.ActiveSheet.PrintCopy
-    ppReport.InsertSlide
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("PRJ_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Unprotect
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("LPU_LIST")
-        s = .Range("C4") & " " & .Range("C3") & ", " & .Range("G4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-End Sub
-
-Sub btLPU_DEL_IT()
-'    Dim cLPU As tLPU
-'    Dim ent_date As String
-'    Dim delete_all As Integer
-'    Dim dlg_del As dlg_LPU_delete
-'
-'    With Worksheets("LPU_LIST")
-'        ent_date = .Range("ent_date")
-'        cLPU.id = .getCurrentLPU_ID()
-'    End With
-'
-'    If cLPU.id = 0 Then
-'        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-'        Exit Sub
-'    End If
-'    cLPU = Get_LPU_Record(cLPU.id)
-'
-'    Set dlg_del = New dlg_LPU_delete
-'    With dlg_del
-'        .chbDeleteQTR.Value = True
-'        .chbDeleteAll.Value = False
-'        .lComment = ent_date & ": �������� ��� '" _
-'        & cLPU.Name & "', �������������� �� ������:" _
-'        & cLPU.address & " �� ���������."
-'        .Show
-'    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    rm_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-        .rm_id = rm_id
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.rm_id = dbRecordset("rm_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id, rm_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    Dim rep_sql As String
-    Dim rm_sql As String
-    
-    rep_sql = ""
-    rm_sql = ""
-    
-    If rep_id <> 0 Then
-        rep_sql = " AND rep_id=" & rep_id
-    End If
-    
-    If rm_id <> 0 Then
-        rm_sql = " AND rm_id=" & rm_id
-    End If
-    
-    
-        getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql
-        getAll_QTR_SQL = "SELECT * FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql & " ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{92648543-CB84-4B6B-BEB3-539AE7EF9D84}{7E20E3E3-027A-483B-A14D-AA9EA5398ACC}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "��������� �����: " & Range("title")
-    Range("view_key") = False
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(%): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{067FED69-B41E-427D-AF59-5798B8E2E73A}{4C13CAB1-FDCC-4708-89EB-E92EDC125712}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id, objQTR.rm_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "���� ������: " & Range("title")
-    
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� ������: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "������� ���: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{9C81F4D2-4ECF-46F5-999B-9801D572A12F}{B382508B-7F3D-4747-8407-0F75F6F265F5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{EA8CE4CE-AC2E-45BC-BAF8-1429E6242097}{575F0762-04F4-4F86-B98A-8E87E3424B0D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(rep_id As Long, rm_id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, rep_id As Long, rm_id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT * FROM " & _
-          "rep WHERE rep_id=" & rep_id & " AND rm_id=" & rm_id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.rm_id = dbRecordset("rm_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    If rm_id <> 0 Then
-        Where = Where & " AND rep.rm_id=" & rm_id
-    End If
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record(Range("RM_ID"))
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN, Range("RM_ID"))
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record(rm_id As Long) As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSet_REGMAN_Record dbConnection, cREGMAN
-'    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object, rm_id As Long) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    objREGMAN.rm_id = rm_id
-    sql = "SELECT * FROM " & _
-          "reg_man WHERE mgr_id=" & rm_id
-          
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM reg_man"
-'    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREGMAN.FirstName & "', " & _
-'    "'" & objREGMAN.LastName & "', " & _
-'    objREGMAN.Region & ", " & _
-'    objREGMAN.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    Name As String
-End Type
-
-Public Type tDBTABLE
-    Name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).Name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).Name = "entry_date"
-    tables(1).field(2).Name = "bdgt_NMG"
-    tables(1).field(3).Name = "bdgt_NFG"
-    tables(1).field(4).Name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).Name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).Name = "entry_date"
-    tables(2).field(2).Name = "operations_per_quarter"
-    tables(2).field(3).Name = "risk_percent"
-    tables(2).field(4).Name = "patients_with_risk_ON"
-    tables(2).field(5).Name = "patients_ambulator"
-    tables(2).field(6).Name = "patients_ambulator_nmg"
-    tables(2).field(7).Name = "patients_ambulator_clexan"
-    tables(2).field(8).Name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).Name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).Name = "patients_stationar_nmg"
-    tables(2).field(11).Name = "patients_stationar_clexan"
-    tables(2).field(12).Name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).Name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).Name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).Name = "entry_date"
-    tables(3).field(2).Name = "patients_with_geparins"
-    tables(3).field(3).Name = "patients_per_quarter"
-    tables(3).field(4).Name = "patients_stationar_nmg"
-    tables(3).field(5).Name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).Name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).Name = "entry_date"
-    tables(4).field(2).Name = "patients_with_geparins"
-    tables(4).field(3).Name = "patients_per_quarter"
-    tables(4).field(4).Name = "patients_stationar_nmg"
-    tables(4).field(5).Name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).Name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).Name = "entry_date"
-    tables(5).field(2).Name = "patients_per_quarter"
-    tables(5).field(3).Name = "risk_percent"
-    tables(5).field(4).Name = "patients_with_risk_ON"
-    tables(5).field(5).Name = "patients_ambulator"
-    tables(5).field(6).Name = "patients_ambulator_nmg"
-    tables(5).field(7).Name = "patients_ambulator_clexan"
-    tables(5).field(8).Name = "patients_stationar_nmg"
-    tables(5).field(9).Name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).Name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).Name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).Name) = getRS(tables(tbl_idx).field(fld_idx).Name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 10)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    tables_to_clear(9) = "quarter_rm"
-    tables_to_clear(10) = "reg_man"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-cdbPRJ
->>>>>>
-Attribute VB_Name = "cdbPRJ"
-Option Explicit
-
-Type tPROJECT
-    total_SALE  As Long ' ����� ����� ������
-    total_BDGT  As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU   As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_RM    As Long ' ����� �����
-    total_BEDS  As Long ' ����� ����� ����
-    total_HIR   As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER   As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS   As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN   As Long '  ���� ������ ��������
-    objRGN() As tREGION
-End Type
-
-Function GetPRJ_COMM_DATA(ByRef prj_data As tPROJECT) As Integer
-    Dim i As Integer
-    i = GetRGN_COMM_DATA(prj_data.objRGN, 0)
-    GetPRJ_COMM_DATA = i
-    If i > 0 Then
-        With prj_data
-            .sale_PLAN = 0
-            .total_ACS = 0
-            .total_BDGT = 0
-            .total_BDGT_NMG = 0
-            .total_BEDS = 0
-            .total_HIR = 0
-            .total_LPU = 0
-            .total_REP = 0
-            .total_RM = 0
-            .total_SALE = 0
-            .total_TER = 0
-            For i = 1 To UBound(prj_data.objRGN)
-                
-            Next i
-        End With
-    End If
-
-End Function
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-        .setEnt_date (getEnt_date())
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("RM_ID") = rm_id
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    Dim rm_struc As tREGMAN
-    
-    i = Range("RM_ID")
-    rm_struc = Get_REGMAN_Record(i)
-    
-    Range("C4") = rm_struc.LastName
-    Range("C5") = rm_struc.FirstName
-
-    Range("G5") = GetRegionName(rm_struc.Region)
-    
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date, Range("RM_ID"))
-
-    
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_LIST")
-        s = .Range("C5") & " " & .Range("C4") & ", " & .Range("G5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("REP_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date, rm_id)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id, allREPID(i).rm_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    rm_id As Long
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION, rm_id As Long) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date, rm_id)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_REP_count As Integer
-            reg_data(i).rm_id = rm_id
-            reg_data(i).ent_date = q_date(i)
-            current_REP_count = getREGION_by_QTR(q_date(i), reg_data(i), rm_id)
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-' if rm_id = 0 then gets all records
-Function getAllQTRNames(ByRef qtr_lst() As String, rm_id As Long) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    
-    If rm_id <> 0 Then
-        sql = sql & " WHERE rm_id=" & rm_id
-    End If
-    
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION, rm_id As Long) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tQTR_COMMON
-    rep_count = Get_QTR_CommonList_by_REP(reps, ent_date, 0, rm_id)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .c_bdgt_NFG + .c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtr.sale_PLAN
-                treg.total_SALE = treg.total_SALE + .c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .c_pat_HIR
-                treg.total_TER = treg.total_TER + .c_pat_TER
-                treg.total_ACS = treg.total_ACS + .c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .i_lcd
-                treg.total_BEDS = treg.total_BEDS + .c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-'            def_dir = GetWBPath(ThisWorkbook.FullName)
-'            If GetImportDirectory(def_dir, flist) Then
-'                Dim db_list() As String
-'                i = GetDBList(flist, db_list)
-'                If i > 0 Then
-'                    ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-'                End If
-'            End If
-'            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Range("ret_addr") = "RM_QTR"
-            Worksheets("REP_LIST").setEnt_date (Worksheets(RM_QTR_SHEET).getEnt_date())
-            Worksheets("REP_LIST").Range("RM_ID") = Worksheets(RM_QTR_SHEET).Range("RM_ID")
-            Worksheets("REP_LIST").Range("VIEW_ONLY") = True
-
-            Worksheets("REP_LIST").Select
-        Case 3
-            MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub btRM_QTR_RET_IT()
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cPPReport
->>>>>>
-Attribute VB_Name = "cPPReport"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Const PPR_NON As Integer = 0
-Const PPR_NEW As Integer = 1
-Const PPR_OLD As Integer = 2
-
-Dim ReportApp As PowerPoint.Application
-Dim ReportDoc As PowerPoint.Presentation
-Dim ReportState As Integer
-Dim PowerPointPath As String
-
-Private Sub Class_Initialize()
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    PowerPointPath = ReportApp.Path & "\PowerPNT.EXE"
-    ReportState = PPR_NON
-End Sub
-
-Sub OpenReport(FileName As String)
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = GetObject(FileName)
-    ReportState = PPR_OLD
-End Sub
-
-Sub CreateReport()
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = ReportApp.Presentations.Add
-    ReportState = PPR_NEW
-End Sub
-
-Sub SaveReport()
-    Select Case ReportState
-        Case PPR_NEW
-            ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME
-        Case PPR_OLD
-            ReportDoc.Save
-    End Select
-    ReportState = PPR_NON
-End Sub
-
-Sub ReportView()
-    Dim CmdName As String
-    CmdName = GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME + ".PPT"
-    CmdName = PowerPointPath & " " & CmdName
-    Shell CmdName, 1
-End Sub
-
-Sub InsertSlide()
-    Dim ReportPage As PowerPoint.Slide
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.count + 1, ppLayoutBlank)
-    
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = "Slide #" & Format(ReportDoc.Slides.count)
-End Sub
-
-
-Private Sub Class_Terminate()
-    SaveReport
-    ReportApp.Quit
-End Sub
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{36355920-F7A4-44A8-96EF-5D79CF26137D}{F852BDF2-AB3E-468E-89DF-EC5DC0C7C88B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-rmImport
->>>>>>
-Attribute VB_Name = "rmImport"
-Option Explicit
-
-Public Type dbDESCRIPTION
-    Name As String
-    Fields() As String
-End Type
-
-Sub ImportFromRegionalManagers(rm_files() As String, fm_file As String)
-    Dim db(9) As dbDESCRIPTION
-    
-    '''''data
-    db(1).Name = "rep"
-    
-    db(2).Name = "lpu"
-    db(3).Name = "lpu_acs"
-    db(4).Name = "lpu_budget"
-    db(5).Name = "lpu_hir"
-    db(6).Name = "lpu_im"
-    db(7).Name = "lpu_ter"
-    db(8).Name = "quarter"
-    db(9).Name = "quarter_rm"
-    
-    ReDim db(1).Fields(5)
-    With db(1)
-        .Fields(1) = "rep_id"
-        .Fields(2) = "firstname"
-        .Fields(3) = "lastname"
-        .Fields(4) = "region"
-        .Fields(5) = "city"
-    End With
-    
-    ReDim db(2).Fields(5)
-    With db(2)
-        .Fields(1) = "id"
-        .Fields(2) = "rep_id"
-        .Fields(3) = "name"
-        .Fields(4) = "address"
-        .Fields(5) = "beds"
-    End With
-    
-    ReDim db(3).Fields(7)
-    With db(3)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(4).Fields(6)
-    With db(4)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "bdgt_NMG"
-        .Fields(5) = "bdgt_NFG"
-        .Fields(6) = "sale_PLAN"
-    End With
-    
-    ReDim db(5).Fields(15)
-    With db(5)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "operations_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_ambulator_clexan_40mg"
-        .Fields(11) = "patients_ambulator_clexan_20mg"
-        .Fields(12) = "patients_stationar_nmg"
-        .Fields(13) = "patients_stationar_clexan"
-        .Fields(14) = "patients_stationar_clexan_40mg"
-        .Fields(15) = "patients_stationar_clexan_20mg"
-    End With
-    
-    
-    ReDim db(6).Fields(7)
-    With db(6)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(7).Fields(11)
-    With db(7)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_stationar_nmg"
-        .Fields(11) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(8).Fields(9)
-    With db(8)
-        .Fields(1) = "ID"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "rep_id"
-        .Fields(4) = "sale_plan"
-        .Fields(5) = "ClxnH20mg"
-        .Fields(6) = "ClxnH40mg"
-        .Fields(7) = "ClxnT40mg"
-        .Fields(8) = "ClxnC_IM"
-        .Fields(9) = "ClxnC_ACS"
-    End With
-    
-    ReDim db(9).Fields(3)
-    With db(9)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "sale_plan"
-    End With
-    
-    Dim rm_idx As Integer
-    Dim to_db As Object
-    'back uo
-    Merge_BackUp_All_Data
-    
-    'clean up
-    Merge_Clear_All_Data fm_file
-    
-    Set to_db = dbGetConnection(fm_file)
-    
-    For rm_idx = 1 To UBound(rm_files)
-        Dim from_db As Object
-        
-        Set from_db = dbGetConnection(rm_files(rm_idx))
-        
-        Dim new_rm_id As Long
-        new_rm_id = dbMergeRM(from_db, to_db)
-
-        Dim i As Integer
-
-        For i = 1 To UBound(db)
-            Dim get_sql As String
-            Dim getRS As Object
-            Dim insRS As Object
-            Dim field_idx As Integer
-                        
-            get_sql = "SELECT * FROM " & db(i).Name
-            Set getRS = CreateObject("ADODB.Recordset")
-            Set insRS = CreateObject("ADODB.Recordset")
-            insRS.Open db(i).Name, to_db, 2, 2
-
-            getRS.Open get_sql, from_db
-            
-            If Not getRS.BOF Then
-                Do While Not getRS.EOF
-                    insRS.addnew
-                    Dim fld_name As String
-                    
-                    For field_idx = 1 To UBound(db(i).Fields)
-                        fld_name = db(i).Fields(field_idx)
-                        insRS(fld_name) = getRS(fld_name)
-                    Next field_idx
-                    
-                    insRS("rm_id") = new_rm_id
-                    insRS.Update
-                    getRS.MoveNext
-                Loop
-            
-            Else
-                'empty table
-                ' do nothing
-            End If
-            
-            
-        Next i
-        
-        dbCloseOpenedConnection from_db
-    Next rm_idx
-    
-    dbCloseOpenedConnection to_db
-End Sub
-
-Function dbMergeRM(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM reg_man"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about Regional Manager! This database cannot be merged!!!"
-            dbMergeRM = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "reg_man", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    dbMergeRM = insertRecordset("mgr_id")
-    
-End Function
-
-Sub cmDataImport()
-    Dim def_dir As String
-    Dim flist() As String
-    Dim i As Integer
-
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        
-        If i > 0 Then
-            ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-        End If
-    End If
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-
-<<<<<<
-======================
-PRJ_QTR
->>>>>>
-Attribute VB_Name = "PRJ_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CPRJ_QT As Integer = 0
-Const CPRJ_ID As Integer = 1
-Const CPRJ_PLN As Integer = 2
-Const CPRJ_FCT As Integer = 3
-Const CPRJ_BDG As Integer = 4
-Const CPRJ_CNT As Integer = 5
-Const CPRJ_BEDS As Integer = 6
-Const CPRJ_HIR As Integer = 7
-Const CPRJ_TER As Integer = 8
-Const CPRJ_CRD As Integer = 9
-Const CPRJ_CLXN_BDG As Integer = 10
-Const CPRJ_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("PRJ_QTR")
-        s = "��� �������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tREGION
-    Dim i As Long
-    Dim r As Range
-
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objQTR(), 0)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CPRJ_QT) = objQTR(i).ent_date
-            r.Offset(i - 1, CPRJ_ID) = ""
-            r.Offset(i - 1, CPRJ_PLN) = objQTR(i).sale_PLAN
-            r.Offset(i - 1, CPRJ_FCT) = objQTR(i).total_SALE
-            r.Offset(i - 1, CPRJ_BDG) = objQTR(i).total_BDGT
-            r.Offset(i - 1, CPRJ_CNT) = objQTR(i).total_LPU
-            r.Offset(i - 1, CPRJ_BEDS) = objQTR(i).total_REP
-            r.Offset(i - 1, CPRJ_HIR) = objQTR(i).total_HIR
-            r.Offset(i - 1, CPRJ_TER) = objQTR(i).total_TER
-            r.Offset(i - 1, CPRJ_CRD) = objQTR(i).total_ACS
-            If objQTR(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_BDG) = objQTR(i).total_SALE / objQTR(i).total_BDGT
-            End If
-            If objQTR(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_NMG) = objQTR(i).total_SALE / objQTR(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CPRJ_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_CLXN_NMG + 1)
-        End If
-    Next i
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Public Sub cbxPRJ_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_PRJ
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_PRJ
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_PRJ
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = PRJ_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CPRJ_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "PRJ_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btPRJ_QTR_Do_IT ' old btRM_OTR_DO_IT
-End Sub
-
-<<<<<<
-======================
-RM_LIST
->>>>>>
-Attribute VB_Name = "RM_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentRM_ID() As Long
-    Dim r As Range
-
-    With Worksheets("RM_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CRM_ID)
-    End With
-
-    getCurrentRM_ID = r
-End Function
-
-Public Sub RM_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("PM_CHR_IDX")
-        Case 1
-            Rm_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rm_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rm_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-
-        Case 4
-            Rm_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectRM_QTR(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "RM_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("RM_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Public Sub SelectREP_LIST(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "REP_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .setEnt_date (getEnt_date())
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateRMList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Sub UpdateRMList()
-    Dim rmcd() As tRMID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_RM_CommonList_by_QTR(rmcd(), ent_date)
-
-    With ThisWorkbook.Worksheets("RM_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rmcd)
-            r.Offset(i - 1, CRM_NAME) = GetRegionName(rmcd(i).rm.Region)
-            r.Offset(i - 1, CRM_ID) = rmcd(i).rm.rm_id
-            r.Offset(i - 1, CRM_BEDS) = rmcd(i).rgcd(1).total_BEDS
-            r.Offset(i - 1, CRM_BDGT) = rmcd(i).rgcd(1).total_BDGT
-            r.Offset(i - 1, CRM_NMG) = rmcd(i).rgcd(1).total_BDGT_NMG
-            r.Offset(i - 1, CRM_HIR) = rmcd(i).rgcd(1).total_HIR
-            r.Offset(i - 1, CRM_TER) = rmcd(i).rgcd(1).total_TER
-            r.Offset(i - 1, CRM_CAR) = rmcd(i).rgcd(1).total_ACS
-            r.Offset(i - 1, CRM_FACT) = rmcd(i).rgcd(1).total_SALE
-            r.Offset(i - 1, CRM_PLAN) = rmcd(i).rgcd(1).sale_PLAN
-            
-            With rmcd(i).rgcd(1)
-                r.Offset(i - 1, CRM_PAT_LPU) = .total_HIR + .total_TER + .total_ACS
-            End With
-            
-            r.Offset(i - 1, CRM_BDGT_1) = rmcd(i).rgcd(1).total_BDGT
-            If rmcd(i).rgcd(1).total_BDGT > 0 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = rmcd(i).rgcd(1).total_SALE / rmcd(i).rgcd(1).total_BDGT
-            End If
-            If r.Offset(i - 1, CRM_BDGT_1 + 1) > 1 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CRM_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CRM_AREA).row, CRM_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CRM_AREA).Column
-
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CRM_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CRM_NAME
-        Range("JUMP") = ""
-    Else
-        btRM_LIST_DO_IT
-    End If
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-<<<<<<
-======================
-mPRJ_QTR
->>>>>>
-Attribute VB_Name = "mPRJ_QTR"
-Sub btPRJ_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("PRJ_ACTION")
-    ent_date = Worksheets(PRJ_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            cmDataImport
-        Case 2
-            Worksheets("RM_LIST").setEnt_date (Worksheets("PRJ_QTR").getEnt_date())
-            Worksheets("RM_LIST").Range("ret_addr") = "PRJ_QTR"
-            Worksheets("RM_LIST").Select
-        Case 3
-            cmNewReport
-    End Select
-    Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-End Sub
-
-
-<<<<<<
-======================
-mRM_LIST
->>>>>>
-Attribute VB_Name = "mRM_LIST"
-Option Explicit
-
-Public Const CRM_AREA As String = "B12"
-Public Const CRM_NAME As Integer = 0
-Public Const CRM_NAME1 As Integer = 1
-Public Const CRM_NAME2 As Integer = 2
-Public Const CRM_ID As Integer = 3
-Public Const CRM_BEDS As Integer = 4
-Public Const CRM_BDGT As Integer = 5
-Public Const CRM_NMG As Integer = 6
-Public Const CRM_HIR As Integer = 7
-Public Const CRM_TER As Integer = 8
-Public Const CRM_CAR As Integer = 9
-Public Const CRM_FACT As Integer = 10
-Public Const CRM_PLAN As Integer = 11
-Public Const CRM_PAT_LPU As Integer = 16
-Public Const CRM_BDGT_1 As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(CRM As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_LIST")
-        s = "�������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub Rm_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub Rm_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CRM_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub btRM_LIST_RET_IT()
-    With Worksheets("RM_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "PRJ_QTR"
-    End With
-    ThisWorkbook.Worksheets("PRJ_QTR").Activate
-End Sub
-
-
-Sub btRM_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rm_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("RM_LIST_ACTION")
-    With Worksheets("RM_LIST")
-        rm_id = .getCurrentRM_ID()
-        
-        Select Case i
-            Case 1:
-                .SelectRM_QTR rm_id
-            Case 2:
-                .SelectREP_LIST rm_id
-            End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mImport2
->>>>>>
-Attribute VB_Name = "mImport2"
-Option Explicit
-
-Sub FOpen()
-    Dim flist As String
-    Dim fileToOpen, s
-    flist = ""
-    fileToOpen = Application _
-        .GetOpenFileName("Data Files (*.mdb), mr*.mdb", Title:="������ ������", MultiSelect:=True)
-    If fileToOpen <> False Then
-        For Each s In fileToOpen
-            flist = flist & s & "; "
-        Next s
-        MsgBox "Open " & flist
-    End If
-End Sub
-
-Sub t2()
-Dim d As ImprtDB
-Set d = New ImprtDB
-d.Show
-
-End Sub
-
-<<<<<<
-======================
-ImprtDB
->>>>>>
-Attribute VB_Name = "ImprtDB"
-Attribute VB_Base = "0{67FA6A28-8370-4981-8F01-1A9079245761}{ECFCB43F-B241-4CD9-9CB3-2A981933173D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-  "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-  lStructSize As Long
-  hWndOwner As Long
-  hInstance As Long
-  lpstrFilter As String
-  lpstrCustomFilter As String
-  nMaxCustFilter As Long
-  nFilterIndex As Long
-  lpstrFile As String
-  nMaxFile As Long
-  lpstrFileTitle As String
-  nMaxFileTitle As Long
-  lpstrInitialDir As String
-  lpstrTitle As String
-  flags As Long
-  nFileOffset As Integer
-  nFileExtension As Integer
-  lpstrDefExt As String
-  lCustData As Long
-  lpfnHook As Long
-  lpTemplateName As String
-End Type
-
-Private Sub Command1_Click()
-  Dim OpenFile As OPENFILENAME
-  Dim lReturn As Long
-  Dim sFilter As String
-  OpenFile.lStructSize = Len(OpenFile)
-'         OpenFile.hwndOwner = Form1.hWnd
-'         OpenFile.hInstance = App.hInstance
-  sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-  OpenFile.lpstrFilter = sFilter
-  OpenFile.nFilterIndex = 1
-  OpenFile.lpstrFile = String(257, 0)
-  OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-  OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-  OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-' OpenFile.lpstrInitialDir = "C:\"
-  OpenFile.lpstrTitle = "������ ������"
-  OpenFile.flags = OFN_HIDEREADONLY + OFN_ALLOWMULTISELECT + OFN_EXPLORER
-  lReturn = GetOpenFileName(OpenFile)
-  If lReturn = 0 Then
-     MsgBox "The User pressed the Cancel Button"
-  Else
-     MsgBox "The user Chose " & Trim(OpenFile.lpstrFile)
-  End If
-End Sub
-
-<<<<<<
-Project Name : 'ClexaneRM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).ClearRMName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "version 1.3"
-Public Const PROGRAM_FILENAME As String = "clexane-rm"
-Public Const PROGRAM_BACKUPNAME As String = "rm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "rm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "mr-ex-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{F2A5159C-AEB6-4066-B85F-339184DAFECD}{712D78F6-CCB6-499E-9674-B992A7482317}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{5D2CB2D2-3E5E-4B6E-9E0C-2EEBA5E10E17}{C891C133-B6B4-43D3-B411-B4A821905C23}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Boolean
-        Dim sum As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BB60E38F-A4AB-4AB4-91D0-40AA798D9F5C}{BE9A54D9-F093-4755-9E17-0B47BB5E2546}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{2C69E842-8DA9-4240-A0A8-F6B0141DC246}{75AAB28C-ADCF-4D1B-9D5A-AF89E80A810C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{BA873669-5C2D-400A-8A8B-572ACD8CCE4C}{D11400A0-9912-4240-A78C-44C33731216A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSet_REGMAN_Record
-    With Worksheets("RM_QTR")
-        .ClearRMName
-        .Range("REP_QTR_INPUT_DATA").ClearContents ' ��� �� ������, �������� ���������
-'        .Range("A1").Select
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-    
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-
-
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Sub ReSetREPRecord()
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbReSetREPRecord dbConnection
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-'Public Sub dbReSetREPRecord(dbConnection As Object)
-'
-'    Dim DeleteSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-       End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmImport()
-    Worksheets(RM_QTR_SHEET).Select
-    ImportData
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("RM_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    End If
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{3EA3C15A-5493-445F-9858-2F241E7D6CEA}{849C1FE1-631A-485D-BE54-A7B73124582C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{B85FF7F1-50C0-4433-BC6F-8A0F2C9BDDDA}{EC2D2B9E-9ED2-4005-A1E9-EF0626D3B7E7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    
-    Unprotect
-    
-    On Error Resume Next
-    
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{EC96F2D1-337D-47DF-B0F1-A6DF3F8CD5CC}{7EB42A63-CBFC-45B0-AE4D-C3E3D8FE7420}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{7B669454-C2AA-4FDF-8311-7ADEDDEF3FF3}{D07A0A02-4923-46C8-8EE8-62769243087D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetLastQTR_fromDB & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRMName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-End Sub
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSet_REGMAN_Record()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSet_REGMAN_Record dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-Public Sub dbReSet_REGMAN_Record(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-End Sub
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� �������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{D5892870-2C88-40C8-A817-AC9B1CF37C2C}{9853EBEA-4E48-41F9-89C0-6F753EB6A0C2}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            ImportData
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub ImportData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        If i > 0 Then
-            Merge_BackUp_All_Data
-            MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-        End If
-    End If
-    Worksheets(RM_QTR_SHEET).update_history
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-Project Name : 'ClexaneMR'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).ClearRepName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(REP_QTR_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-Const CQTR_PAT_ALL As Integer = 16
-Const CQTR_BDGT_ALL As Integer = 17
-
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRepName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-    Range("H5") = ""
-End Sub
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREP
-    
-    cRep = GetREPRecord
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-    
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    i = GetAll_QTR_Records(objQTR, "%")
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList(qcd)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_plan
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_BBL_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-
-Private Sub Worksheet_Activate()
-  
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-    
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CRow_Width Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-    
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub DO_New_qtr()
-    Dim res As Variant
-    Dim objQTR As tQTR
-    Dim s As String
-    s = GetLastQtr
-    objQTR.entry_date = GetNextQTR(s)
-    
-    If objQTR.entry_date = "" Then
-        Exit Sub
-    End If
-    
-    DO_Price_qtr objQTR.entry_date
-
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        Dim qtr As tQTR
-        Dim res As Integer
-        
-        qtr = Get_QTR_Record(ent_date)
-        
-        If qtr.id = 0 Then
-            qtr.entry_date = ent_date
-    
-            With Worksheets(VAR_SHEET)
-                qtr.ClxnH20mg = .Range("ClxnH20mg")
-                qtr.ClxnH40mg = .Range("ClxnH40mg")
-                qtr.ClxnT40mg = .Range("ClxnT40mg")
-                qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-                qtr.ClxnC_IM = .Range("ClxnC_IM")
-            End With
-        End If
-        
-        Dim dlg_nq As dlg_nextQTR
-        Set dlg_nq = New dlg_nextQTR
-        
-        With dlg_nq
-            .tb_qtr_name = qtr.entry_date
-            .tb_bdgt_avts = qtr.sale_plan
-            .tb_qtr_name = qtr.entry_date
-            .tb_ClxnH20mg = qtr.ClxnH20mg
-            .tb_ClxnH40mg = qtr.ClxnH40mg
-            .tb_ClxnT40mg = qtr.ClxnT40mg
-            .tb_ClxnC_ACS = qtr.ClxnC_ACS
-            .tb_ClxnC_IM = qtr.ClxnC_IM
-        End With
-        
-        dlg_nq.Show
-        res = dlg_nq.Tag
-        
-        If res = vbOK Then
-            With dlg_nq
-                If Not IsNumeric(.tb_bdgt_avts) Then
-                    MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                Else
-                    If .tb_bdgt_avts = 0 Then
-                        MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                        Exit Sub
-                    End If
-                End If
-                Dim bool As Boolean
-                bool = IsNumeric(.tb_ClxnH20mg) _
-                    And IsNumeric(.tb_ClxnH40mg) _
-                    And IsNumeric(.tb_ClxnT40mg) _
-                    And IsNumeric(.tb_ClxnC_ACS) _
-                    And IsNumeric(.tb_ClxnC_IM)
-                If Not bool Then
-                    MsgBox "������� ��������� �����", vbOK, PROGRAM_NAME
-                    Exit Sub
-                End If
-                qtr.sale_plan = .tb_bdgt_avts
-                qtr.entry_date = .tb_qtr_name
-                qtr.ClxnH20mg = .tb_ClxnH20mg
-                qtr.ClxnH40mg = .tb_ClxnH40mg
-                qtr.ClxnT40mg = .tb_ClxnT40mg
-                qtr.ClxnC_ACS = .tb_ClxnC_ACS
-                qtr.ClxnC_IM = .tb_ClxnC_IM
-            End With
-            Insert_QTR_Record qtr
-        End If
-    End If
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = False
-            .Range("ent_date") = ent_date
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        Dim i As Integer
-        i = MsgBox("������� ������ �� ������ [" & ent_date & "]?", vbDefaultButton2 + vbOKCancel, PROGRAM_NAME)
-        If i = vbOK Then
-            Dim objQTR As tQTR
-            If ent_date <> "" Then
-                objQTR.entry_date = ent_date
-                objQTR = Get_QTR_Record(ent_date)
-                Delete_QTR_Record objQTR
-                Worksheets(TITLE_SHEET).Select
-                Worksheets(REP_QTR_SHEET).Select
-            End If
-        End If
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            DO_New_qtr
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            dbExport
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    End Select
-    If idx <> 2 Then
-        With ThisWorkbook
-            .Worksheets(TITLE_SHEET).Select
-            .Worksheets(REP_QTR_SHEET).Select
-        End With
-    End If
-End Sub
-
-Sub Delete_qtr()
-    Dim ent_date As String
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    DO_Delete_qtr ent_date
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[MR]"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-    
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-    
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-        
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-                   
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-       
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CINP_WIDTH Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-    
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-        
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    lpu_id = r
-    
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-    
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-    
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-            
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-        
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-        
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-        
-        Case Else
-            Range("JUMP") = ""
-    End Select
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-    
-    is_input_range = INPUT_NO
-    
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-    
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREP
-    
-    ' ent_date = "%" ' % - all records
-    ent_date = getEnt_date
-    
-    objQTR = Get_QTR_Record(ent_date)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-     
-    ' ������� ���
-    Range("C3:C4").ClearContents
-    cRep = GetREPRecord
-    
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_plan
-    
-
-    
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-        
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-            
-         
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_plan
-            
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-            
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{566B33D6-957A-43E4-8444-D8EA3889700C}{42EE65B8-F8C6-4F95-9F52-7738BF6FCEAD}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-    
-        Dim objHir As tHIRURGIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.Count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-        
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-    
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-            Application.ScreenUpdating = False
-            
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-            
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{EBA94131-180E-4709-A2A3-B60D48987620}{47A860A1-BF92-4EBB-A333-AB7E83FAB868}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_plan = Round(Range("F13").Value, 0)
-            
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_plan
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_plan <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("��������� ������� ��������?", vbYesNo, PROGRAM_NAME) Then
-                    Insert_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-    
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_plan
-    
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    objQTR = Get_QTR_Record(ent_date)
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-    
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-        
-        SetupData cLPU
-        
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case INPUT_CHECK
-            
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{E3F10C5A-A4B4-42FF-A2C9-6F8198210A07}{563D0F3D-F79D-48F1-AFE4-A2136809B982}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{137EDDE5-3DB4-4BAD-A245-324DC31ABB36}{3BD7159A-BF6C-403F-B3DF-4834FA9E4D92}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{8EB80D4C-3476-421A-A370-6332A07DE509}{A7542905-C9F8-4F39-AD67-B62A88F8F4E6}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREP
->>>>>>
-Attribute VB_Name = "mREP"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSetREPRecord
-    With Worksheets("REP_QTR")
-        .ClearRepName
-        .Range("REP_QTR_INPUT_DATA").ClearContents
-        .Range("QTR_SEL") = ""
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-        Worksheets("REP_QTR").Range("QTR_SEL") = ""
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cUser As tREP
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cUser = GetREPRecord()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cUser.Region
-        .Range("IDX_CITY") = cUser.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cUser.Region
-        .cbCity = cUser.City
-        .tbFName = cUser.FirstName
-        .tbLName = cUser.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cUser
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        SetREPRecord cUser
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_plan As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim SQL As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_plan = 0
-    End With
-        
-    
-    SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_plan = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_plan = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_plan
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_plan & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPU(allLPU() As tLPU) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPU = dbGetAllLPU(dbConnection, allLPU)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPUbyQTR(allLPU() As tLPU, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPUbyQTR = dbGetAllLPUbyQTR(dbConnection, allLPU, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objLPU.id = 0 then insert else update
-Sub Insert_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    If objLPU.id = 0 Then
-        dbInsert_LPU_Record dbConnection, objLPU
-    Else
-        dbUpdate_LPU_Record dbConnection, objLPU
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub Delete_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDelete_LPU_Record dbConnection, objLPU
-    dbCloseConnection dbConnection
-End Sub
-
-Sub Delete_LPU_RecordQTR(ByRef objLPU As tLPU, ent_date As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-    dbCloseConnection dbConnection
-    
-End Sub
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim SQL As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    SQL = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Sub dbInsert_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-  
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu", dbConnection, 2, 2
-    dbRecordset.addnew
-    dbRecordset("name") = objLPU.name
-    dbRecordset("address") = objLPU.address
-    dbRecordset("rep_id") = objLPU.rep_id
-    dbRecordset("beds") = objLPU.beds
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objLPU.id = dbRecordset("id")
-  
-End Sub
-
-Sub dbUpdate_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu SET " & _
-    "name='" & objLPU.name & "'," & _
-    "address='" & objLPU.address & "'," & _
-    "beds=" & objLPU.beds & "," & _
-    "rep_id=" & objLPU.rep_id& & _
-    " WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-
-Function dbGetAllLPU(dbConnection As Object, allLPU() As tLPU) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu"
-    getAll_LPU_SQL = "SELECT * FROM lpu"
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPU = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAllLPUbyQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim where As String
-    where = "WHERE lpu_budget.entry_date like '" & ent_date & "'"
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget " & where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & where & " AND lpu.id=lpu_budget.lpu_id"
-    
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPUbyQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Sub dbDelete_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu " & _
-    "WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Hir_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Ter_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_ACS_RecordsByLPU_ID dbConnection, objLPU.id
-    
-End Sub
-
-Sub dbDelete_LPU_RecordQTR(dbConnection As Object, ByRef objLPU As tLPU, ent_date As String)
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-End Sub
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-Option Explicit
-
-Public Type tREP
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetREPRecord() As tREP
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetREPRecord = dbGetREPRecord(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub SetREPRecord(cUser As tREP)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSetREPRecord dbConnection, cUser
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSetREPRecord()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSetREPRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGetREPRecord(dbConnection As Object) As tREP
-    
-    Dim SQL As String
-    Dim objREP As tREP
-    
-    objREP.FirstName = ""
-    objREP.LastName = ""
-    objREP.Region = 0
-    objREP.City = 0
-    SQL = "SELECT firstname, lastname, region, city FROM " & _
-          "rep"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREP.FirstName = dbRecordset("firstname")
-        objREP.LastName = dbRecordset("lastname")
-        objREP.Region = dbRecordset("region")
-        objREP.City = dbRecordset("city")
-        
-    End If
-    
-    dbGetREPRecord = objREP
-        
-End Function
-
-Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREP.FirstName & "', " & _
-    "'" & objREP.LastName & "', " & _
-    objREP.Region & ", " & _
-    objREP.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-End Sub
-
-Public Sub dbReSetREPRecord(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("REP_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-'                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = Double2Str(.risk_percent, 3)
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub test()
-    Dim s As String
-    Dim d As Single
-    d = 1235.6789
-    s = Format(d, "####0,00")
-    MsgBox s
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    Dim del_request As Integer
-    Dim allLPU() As tLPU
-    Dim lpu_count As Integer
-    Dim i As Integer
-    Dim tmp_LPU_List As Range
-    Dim tmp_LPU_List_Addr As String
-    Dim r_end As Range
-    Dim dlg As Dlg_lpu_card
-    
-    Set dlg = New Dlg_lpu_card
-    
-    lpu_count = GetAllLPU(allLPU)
-    With Worksheets(VAR_SHEET)
-        Set tmp_LPU_List = .Range("tmp_LPU_List")
-        Set r_end = .Range(tmp_LPU_List, tmp_LPU_List.End(xlDown))
-        Set r_end = .Range(r_end, r_end.End(xlToRight))
-        .Range(tmp_LPU_List, r_end).ClearContents
-    End With
-        
-    If lpu_count <> 0 Then
-        dlg.cbxLPU_List_Enable.Enabled = True
-        For i = 1 To UBound(allLPU)
-            tmp_LPU_List.Cells(i, 1) = allLPU(i).name
-            tmp_LPU_List.Cells(i, 2) = allLPU(i).address
-            tmp_LPU_List.Cells(i, 3) = allLPU(i).beds
-            tmp_LPU_List.Cells(i, 4) = allLPU(i).id
-        Next i
-    Else
-        dlg.cbxLPU_List_Enable.Enabled = False
-    End If
-    
-    tmp_LPU_List_Addr = Worksheets(VAR_SHEET).name & "!" & _
-            Worksheets(VAR_SHEET).Range(tmp_LPU_List, tmp_LPU_List.End(xlDown)).address
-
-    With dlg
-        .cbLPU_List.RowSource = tmp_LPU_List_Addr
-        .cbLPU_List.ListIndex = 0
-        .cbxLPU_List_Enable = False
-        .cbLPU_List.Enabled = False
-        If cLPU.id <> 0 Then
-            .cbxLPU_List_Enable.Enabled = False
-        Else
-            If lpu_count <> 0 Then
-                .cbxLPU_List_Enable.Enabled = True
-            Else
-                .cbxLPU_List_Enable.Enabled = False
-            End If
-        End If
-        .tb_lpu_name.Text = cLPU.name
-        .tb_lpu_address.Text = cLPU.address
-        .tbBedsCount = cLPU.beds
-
-        .Tag = vbCancel
-    End With
-    
-    dlg.Show
-    
-    If Not IsNumeric(dlg.Tag) Then
-        Exit Sub
-    End If
-    
-    If dlg.Tag = vbOK Then
-        Dim n As Variant
-        Dim test As Integer
-        test = 0
-        n = dlg.tbBedsCount.Value
-        If Not IsNumeric(n) Then
-            test = 1
-        Else
-            If n = 0 Then
-                test = 1
-            End If
-        End If
-        If test = 0 Then
-            
-            cLPU.name = dlg.tb_lpu_name.Text
-            cLPU.address = dlg.tb_lpu_address.Text
-            cLPU.beds = dlg.tbBedsCount.Value
-                                    
-            If cLPU.name = "" Or cLPU.address = "" Then
-                test = 2
-            End If
-        End If
-        Select Case test
-            Case 0
-                If dlg.cbxLPU_List_Enable.Value = True Then
-                    cLPU.id = tmp_LPU_List.Cells(dlg.cbLPU_List.ListIndex + 1, 4)
-                End If
-                Insert_LPU_Record cLPU
-                ' ��������� ������� ������ ��� ��� � ��������
-                Dim bdgt As tBUDGET
-                bdgt = Get_BDGT_Record(cLPU.id, ent_date)
-                ' ������ ���: ������� ������ ������ � lpu_budget
-                If bdgt.id = 0 Then
-                    bdgt.lpu_id = cLPU.id
-                    bdgt.entry_date = ent_date
-                    Insert_BDGT_Record bdgt
-                End If
-            Case 1
-                MsgBox "������� ��������� ���������� ������ ����� ��� 1!", vbOKOnly, PROGRAM_NAME
-            Case 2
-                MsgBox "������������ � ����� ��� �� ������ ���� �������!", vbOKOnly, PROGRAM_NAME
-        End Select
-    End If
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-    
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-    
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-    
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & "."
-        .Show
-        
-        If .Tag = vbOK Then
-            If .chbDeleteAll.Value Then
-                delete_all = _
-                    MsgBox("��� ������ �� ��� � ������ '" & cLPU.name & _
-                    "' ����� ������� ��������.", vbOK, PROGRAM_NAME)
-                If delete_all = vbOK Then
-                    Delete_LPU_Record cLPU
-                End If
-            Else
-                Delete_LPU_RecordQTR cLPU, ent_date
-            End If
-        End If
-    End With
-    
-    With ThisWorkbook
-        .Worksheets(TITLE_SHEET).Select
-        .Worksheets("LPU_LIST").Select
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Activate
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-        
-    
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id <> 0 And i = 1 Then
-            lpu_id = 0
-        End If
-        If lpu_id = 0 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1, 6
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                If lpu_id <> 0 Then
-                    .SelectLPU_BDGT lpu_id, ent_date
-                    .Range("JUMP") = "LPU_BDGT"
-                End If
-            Case 3
-                If lpu_id <> 0 Then
-                    .SelectLPU_HIR lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_HIR"
-                End If
-            Case 4
-                If lpu_id <> 0 Then
-                    .SelectLPU_TER lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_TER"
-                End If
-            Case 5
-                If lpu_id <> 0 Then
-                    .SelectLPU_C_ACS lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_C_ACS"
-                End If
-        End Select
-    End With
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_plan As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    Else
-        getLast_QTR_SQL = ""
-    End If
-    
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Sub Insert_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTR.id <> 0 Then
-        dbUpdate_QTR_Record dbConnection, objQTR
-    Else
-        dbInsert_QTR_Record dbConnection, objQTR
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTR_Record(ent_date As String) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, ent_date)
-    If i <> 0 Then
-        Get_QTR_Record = allQTR(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records(ByRef All_QTR() As tQTR, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTR_Records = dbGetAll_QTR_Records(dbConnection, All_QTR, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTR_Record dbConnection, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTR.ID <> 0 then updatre else insert
-Sub dbInsert_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTR
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_plan
-        dbRecordset("rep_id") = .rep_id
-        dbRecordset("ClxnH20mg") = .ClxnH20mg
-        dbRecordset("ClxnH40mg") = .ClxnH40mg
-        dbRecordset("ClxnT40mg") = .ClxnT40mg
-        dbRecordset("ClxnC_IM") = .ClxnC_IM
-        dbRecordset("ClxnC_ACS") = .ClxnC_ACS
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTR.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim Update_SQL As String
-    
-    With objQTR
-        Update_SQL = "UPDATE quarter SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rep_id=" & .rep_id & "," & _
-            "sale_plan=" & .sale_plan & "," & _
-            "ClxnH20mg=" & .ClxnH20mg & "," & _
-            "ClxnH40mg=" & .ClxnH40mg & "," & _
-            "ClxnT40mg=" & .ClxnT40mg & "," & _
-            "ClxnC_IM=" & .ClxnC_IM & "," & _
-            "ClxnC_ACS=" & .ClxnC_ACS & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTR_Records(dbConnection As Object, All_QTR() As tQTR, ent_date As String) As Integer
-    
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter WHERE entry_date like '" & ent_date & "'"
-    getAll_QTR_SQL = "SELECT * FROM quarter WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTR_Records = QTR_Count
-    
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim All_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_plan = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 All_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter " & _
-    "WHERE id=" & objQTR.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Hir_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Ter_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_ACS_RecordsByQTR dbConnection, objQTR.entry_date
-       
-End Sub
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList(ByRef qcd() As tQTR_COMMON) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList = dbGet_QTR_CommonList(dbConnection, qcd)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList(dbConnection As Object, ByRef qcd() As tQTR_COMMON) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, "%")
-    dbGet_QTR_CommonList = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_plan
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    On Error GoTo l_exit
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-l_exit:
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-        .EditDirectlyInCell = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{2FC04B4C-EB99-433E-ACDB-A920D02B9B5B}{777B85CC-ADE3-4188-94C8-9E07DA8B5076}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    On Error GoTo ExitLabel
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.Count
-                On Error Resume Next
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{3F7D7D75-90F6-4829-9E24-CA5391BB2A03}{A1A0F296-0D28-4123-8E38-82FA6EE6F2EF}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAllLPUbyQTR(dbConnection, allLPU, objQTR.entry_date)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-   
-    Unprotect
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-        
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{91AE5FA0-01C7-4C10-9E5F-D1D2DDF29401}{5726592A-BC0A-4E79-A963-35D354045716}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{FB055133-927F-41FF-BC90-442833A40591}{11BCAB43-1EDD-440B-AB0E-20CD6E42E11A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tID_REP
-    id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Public Type tID_REP_COMMON
-    id_rep As tID_REP
-    i_qtr As Long
-    qtrs As tQTR_COMMON
-End Type
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim last_qtr As String
-    
-    On Error GoTo ErrHandler
-    
-    last_qtr = GetLastQTR_fromDB
-    If last_qtr = "" Then
-        MsgBox "��� ������� � ���� ������. ������� ����������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & last_qtr & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub t()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Save
-End Sub
-
-Private Sub Workbook_Open()
-    FindRestoreData
-End Sub
-
-Sub FindRestoreData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim dbname As String
-    Dim caption As String
-    caption = PROGRAM_NAME + " " + PROGRAM_VERSION
-    If MsgBox("�������������� ������. ����������?", vbYesNo, caption) = vbYes Then
-        def_dir = "C:\CLEXANE"
-        If GetDBName(def_dir, dbname) Then
-            HWReset dbname
-            MsgBox "������ � ����� " + dbname + " ������������� :)", vbOKOnly, caption
-        Else
-            MsgBox "����� ��� ���������"
-        End If
-    End If
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mDataBase
->>>>>>
-Attribute VB_Name = "mDataBase"
-Option Explicit
-
-Sub dbOpenConnection(dbConnection As Object, dbname As String)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = dbname
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Sub HWReset(dbname As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection, dbname
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-mGetDBName
->>>>>>
-Attribute VB_Name = "mGetDBName"
-Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetDBName(DB_dir As String, dbname As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "clexane*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "����������� ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetDBName = False
-        dbname = ""
-    Else
-        GetDBName = True
-        Dim flist() As String
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        dbname = flist(0)
-    End If
-End Function
-
-
-<<<<<<
-Project Name : 'ClexaneRM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).ClearRMName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "version 1.3"
-Public Const PROGRAM_FILENAME As String = "clexane-rm"
-Public Const PROGRAM_BACKUPNAME As String = "rm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "rm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "mr-ex-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{F2A5159C-AEB6-4066-B85F-339184DAFECD}{712D78F6-CCB6-499E-9674-B992A7482317}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{5D2CB2D2-3E5E-4B6E-9E0C-2EEBA5E10E17}{C891C133-B6B4-43D3-B411-B4A821905C23}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Boolean
-        Dim sum As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BB60E38F-A4AB-4AB4-91D0-40AA798D9F5C}{BE9A54D9-F093-4755-9E17-0B47BB5E2546}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{2C69E842-8DA9-4240-A0A8-F6B0141DC246}{75AAB28C-ADCF-4D1B-9D5A-AF89E80A810C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{BA873669-5C2D-400A-8A8B-572ACD8CCE4C}{D11400A0-9912-4240-A78C-44C33731216A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSet_REGMAN_Record
-    With Worksheets("RM_QTR")
-        .ClearRMName
-        .Range("REP_QTR_INPUT_DATA").ClearContents ' ��� �� ������, �������� ���������
-'        .Range("A1").Select
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-    
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-
-
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Sub ReSetREPRecord()
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbReSetREPRecord dbConnection
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-'Public Sub dbReSetREPRecord(dbConnection As Object)
-'
-'    Dim DeleteSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-       End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmImport()
-    Worksheets(RM_QTR_SHEET).Select
-    ImportData
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("RM_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    End If
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{3EA3C15A-5493-445F-9858-2F241E7D6CEA}{849C1FE1-631A-485D-BE54-A7B73124582C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{B85FF7F1-50C0-4433-BC6F-8A0F2C9BDDDA}{EC2D2B9E-9ED2-4005-A1E9-EF0626D3B7E7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    
-    Unprotect
-    
-    On Error Resume Next
-    
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{EC96F2D1-337D-47DF-B0F1-A6DF3F8CD5CC}{7EB42A63-CBFC-45B0-AE4D-C3E3D8FE7420}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{7B669454-C2AA-4FDF-8311-7ADEDDEF3FF3}{D07A0A02-4923-46C8-8EE8-62769243087D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetLastQTR_fromDB & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRMName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-End Sub
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSet_REGMAN_Record()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSet_REGMAN_Record dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-Public Sub dbReSet_REGMAN_Record(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-End Sub
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� �������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{D5892870-2C88-40C8-A817-AC9B1CF37C2C}{9853EBEA-4E48-41F9-89C0-6F753EB6A0C2}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            ImportData
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub ImportData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        If i > 0 Then
-            Merge_BackUp_All_Data
-            MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-        End If
-    End If
-    Worksheets(RM_QTR_SHEET).update_history
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-Project Name : 'ClexanePM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    Application.ScreenUpdating = True
-'    CheckUser
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).update_history
-    Application.Calculate
-
-End Sub
-
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "QTR_SEL"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Worksheets(REP_QTR_SHEET).Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .setEnt_date (ent_date)
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).getEnt_date()
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public ppReport As New cPPReport
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[PM]"
-Public Const PROGRAM_VERSION As String = "Clexane[PM] ver 1.1"
-Public Const PROGRAM_FILENAME As String = "clexane-pm"
-Public Const PROGRAM_BACKUPNAME As String = "pm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "pm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "rm-ex*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-Public Const CHART_DEF_TITLE As String = "* * *"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20031207
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O41"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-Public Const PRJ_QTR_SHEET As String = "PRJ_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Function time_correct(end_date As Long, ByVal theDate As Date) As Boolean
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-    If end_date = NO_ESTIMATION_DATE Then
-        time_correct = True
-        Exit Function
-    End If
-    
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    
-    time_correct = CurDate <= end_date
-    
-End Function
-
-Sub EnableRun(end_date As Long)
-    If Not time_correct(end_date, Now) Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub t()
-    EnableRun ESTIMATION_DATE
-End Sub
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Sub OpenPPT()
-    ppReport.ReportView
-End Sub
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    SelectLPU_BDGT lpu_id, ent_date
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .setEnt_date (ent_date)
-            .Range("lpu_id") = lpu_id
-            .Range("REP_ID") = rep_id
-            .Range("RM_ID") = rm_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("RM_ID") = rm_id
-        .Range("REP_ID") = rep_id
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.Name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{32FB0F3D-6884-41DC-99DB-E2C55B2257C4}{DED79A66-DA60-4CCC-9003-082480235D55}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{0DC9E035-CE0A-49FF-85A2-A4EC5FF8FE96}{D54DDC8A-1EE2-4BB3-8B94-343B521AF098}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S15"
-
-Sub PrintCopy()
-    Range("B1:K21").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), Range("RM_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    objLPU = Get_LPU_Record(id, Range("RM_ID"))
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.Name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BFB4547C-96A7-4739-AA0A-CEF1E35E2BDC}{C3D618A3-9410-4BC7-9D93-3B049D361132}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.Name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-    sh.Range("ret_addr") = ""
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{9AAD262F-A6C4-4912-9C58-D7A2071181B8}{9470F4EB-DA9F-4584-9159-D09319548D21}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{A8FBEE9C-DE59-49DE-971D-07BC9C0E9BD2}{C712732B-D8E4-4C2D-8E78-AC90968E0CD7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hw_reset()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        MsgBox "2"
-        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-'    Dim cREGMAN As tREGMAN
-'    Dim idx As Integer
-'    Dim dlg_ui As UserInfo
-'
-'    Set dlg_ui = New UserInfo
-'
-'    cREGMAN = Get_REGMAN_Record()
-'
-'    With ThisWorkbook.Worksheets(REGS_SHEET)
-'        .Range("IDX_REGION") = cREGMAN.Region
-'        .Range("IDX_CITY") = cREGMAN.City
-'    End With
-'
-'    With dlg_ui
-'        .cbRegion = cREGMAN.Region
-'        .cbCity = cREGMAN.City
-'        .tbFName = cREGMAN.FirstName
-'        .tbLName = cREGMAN.LastName
-'    End With
-'
-'    dlg_ui.Show
-'    Worksheets(REGS_SHEET).Calculate
-'
-'    If dlg_ui.Tag = vbOK Then
-'        With cREGMAN
-'            .Region = dlg_ui.cbRegion.Value
-'            .City = dlg_ui.cbCity.Value
-'            .FirstName = dlg_ui.tbFName.Value
-'            .LastName = dlg_ui.tbLName.Value
-'        End With
-'        Set_REGMAN_Record cREGMAN
-'    Else
-'        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-'    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    rm_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String, rm_id As Long) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String, rm_id As Long) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .rm_id = rm_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    rm_id As Long
-    Name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long, rm_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long, rm_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.Name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.Name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.rm_id = dbRecordset("rm_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id " & _
-    "AND lpu.rep_id=" & rep_id & " AND lpu.rm_id=lpu_budget.rm_id AND lpu.rm_id=" & rm_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds, lpu.rm_id AS rm_id " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .Name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cdbRM
->>>>>>
-Attribute VB_Name = "cdbRM"
-Option Explicit
-
-Public Type tRMID_COMMON
-    rm As tREGMAN
-    rgcd_count As Integer
-    rgcd() As tREGION
-End Type
-
-Function Get_RM_CommonList_by_QTR(ByRef rmcd() As tRMID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_RM_CommonList_by_QTR = dbGet_RM_CommonList_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_RM_CommonList_by_QTR(dbConnection As Object, ByRef rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    ' �������� ������ RM-��
-    Dim count As Integer
-    count = db_get_All_RM_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    Dim i As Integer
-    For i = 1 To count
-        rmcd(i).rgcd_count = 1
-        ReDim rmcd(i).rgcd(1 To 1)
-        getREGION_by_QTR ent_date, rmcd(i).rgcd(1), rmcd(i).rm.rm_id
-    Next i
-    dbGet_RM_CommonList_by_QTR = count
-End Function
-
-Function db_get_All_RM_by_QTR(dbConnection As Object, rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    
-    Dim count_sql As String
-    Dim get_sql As String
-    Dim rs As Object
-    Dim RM_Count As Integer
-        
-    count_sql = "SELECT COUNT(*) AS RM_TOTAL FROM reg_man"
-    get_sql = "SELECT * FROM reg_man"
-    Set rs = CreateObject("ADODB.Recordset")
-    rs.Open count_sql, dbConnection
-    
-    If Not rs.BOF Then
-        RM_Count = rs("RM_TOTAL")
-    End If
-    
-    rs.Close
-    
-     db_get_All_RM_by_QTR = RM_Count
-    
-    If RM_Count > 0 Then
-        'we have records
-        ReDim rmcd(1 To RM_Count)
-        Dim index As Long
-        index = 1
-        rs.Open get_sql, dbConnection
-        
-        If Not rs.BOF Then
-             Do While Not rs.EOF
-                 Dim tmp_rmcd As tRMID_COMMON
-                 With tmp_rmcd
-                    .rgcd_count = 0
-                    .rm.City = rs("city")
-                    .rm.FirstName = rs("firstname")
-                    .rm.LastName = rs("lastname")
-                    .rm.rm_id = rs("mgr_id")
-                    .rm.Region = rs("region")
-                 End With
-                 
-                 rmcd(index) = tmp_rmcd
-                 index = index + 1
-                 rs.MoveNext
-             Loop
-        End If
-    End If
-    
-End Function
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-           With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub CreateExtCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom extendet commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Add New Slide"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 280
-                .OnAction = "cmAddSlide"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        Application.ScreenUpdating = False
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        Application.ScreenUpdating = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmNewReport()
-    ppReport.CreateReport
-    MsgBox "����� ����� ������", vbInformation + vbOKOnly, PROGRAM_NAME
-    CreateExtCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmOpenReport()
-    Dim fileToOpen
-    Dim s As String
-    fileToOpen = Application _
-        .GetOpenFileName("Report Files (*.ppt), *.ppt", title:="Report OPen", MultiSelect:=False)
-    If fileToOpen <> False Then
-        s = fileToOpen
-        ppReport.OpenReport s
-        CreateExtCommandBar theApp:=ThisWorkbook.Application
-    End If
-End Sub
-
-Sub cmCloseReport()
-    On Error Resume Next
-    ppReport.SaveReport
-    CreateCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmAddSlide()
-    ThisWorkbook.ActiveSheet.PrintCopy
-    ppReport.InsertSlide
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("PRJ_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Unprotect
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("LPU_LIST")
-        s = .Range("C4") & " " & .Range("C3") & ", " & .Range("G4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-End Sub
-
-Sub btLPU_DEL_IT()
-'    Dim cLPU As tLPU
-'    Dim ent_date As String
-'    Dim delete_all As Integer
-'    Dim dlg_del As dlg_LPU_delete
-'
-'    With Worksheets("LPU_LIST")
-'        ent_date = .Range("ent_date")
-'        cLPU.id = .getCurrentLPU_ID()
-'    End With
-'
-'    If cLPU.id = 0 Then
-'        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-'        Exit Sub
-'    End If
-'    cLPU = Get_LPU_Record(cLPU.id)
-'
-'    Set dlg_del = New dlg_LPU_delete
-'    With dlg_del
-'        .chbDeleteQTR.Value = True
-'        .chbDeleteAll.Value = False
-'        .lComment = ent_date & ": �������� ��� '" _
-'        & cLPU.Name & "', �������������� �� ������:" _
-'        & cLPU.address & " �� ���������."
-'        .Show
-'    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    rm_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-        .rm_id = rm_id
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.rm_id = dbRecordset("rm_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id, rm_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    Dim rep_sql As String
-    Dim rm_sql As String
-    
-    rep_sql = ""
-    rm_sql = ""
-    
-    If rep_id <> 0 Then
-        rep_sql = " AND rep_id=" & rep_id
-    End If
-    
-    If rm_id <> 0 Then
-        rm_sql = " AND rm_id=" & rm_id
-    End If
-    
-    
-        getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql
-        getAll_QTR_SQL = "SELECT * FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql & " ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{92648543-CB84-4B6B-BEB3-539AE7EF9D84}{7E20E3E3-027A-483B-A14D-AA9EA5398ACC}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "��������� �����: " & Range("title")
-    Range("view_key") = False
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(%): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{067FED69-B41E-427D-AF59-5798B8E2E73A}{4C13CAB1-FDCC-4708-89EB-E92EDC125712}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id, objQTR.rm_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "���� ������: " & Range("title")
-    
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� ������: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "������� ���: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{9C81F4D2-4ECF-46F5-999B-9801D572A12F}{B382508B-7F3D-4747-8407-0F75F6F265F5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{EA8CE4CE-AC2E-45BC-BAF8-1429E6242097}{575F0762-04F4-4F86-B98A-8E87E3424B0D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(rep_id As Long, rm_id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, rep_id As Long, rm_id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT * FROM " & _
-          "rep WHERE rep_id=" & rep_id & " AND rm_id=" & rm_id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.rm_id = dbRecordset("rm_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    If rm_id <> 0 Then
-        Where = Where & " AND rep.rm_id=" & rm_id
-    End If
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record(Range("RM_ID"))
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN, Range("RM_ID"))
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record(rm_id As Long) As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSet_REGMAN_Record dbConnection, cREGMAN
-'    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object, rm_id As Long) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    objREGMAN.rm_id = rm_id
-    sql = "SELECT * FROM " & _
-          "reg_man WHERE mgr_id=" & rm_id
-          
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM reg_man"
-'    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREGMAN.FirstName & "', " & _
-'    "'" & objREGMAN.LastName & "', " & _
-'    objREGMAN.Region & ", " & _
-'    objREGMAN.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    Name As String
-End Type
-
-Public Type tDBTABLE
-    Name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).Name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).Name = "entry_date"
-    tables(1).field(2).Name = "bdgt_NMG"
-    tables(1).field(3).Name = "bdgt_NFG"
-    tables(1).field(4).Name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).Name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).Name = "entry_date"
-    tables(2).field(2).Name = "operations_per_quarter"
-    tables(2).field(3).Name = "risk_percent"
-    tables(2).field(4).Name = "patients_with_risk_ON"
-    tables(2).field(5).Name = "patients_ambulator"
-    tables(2).field(6).Name = "patients_ambulator_nmg"
-    tables(2).field(7).Name = "patients_ambulator_clexan"
-    tables(2).field(8).Name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).Name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).Name = "patients_stationar_nmg"
-    tables(2).field(11).Name = "patients_stationar_clexan"
-    tables(2).field(12).Name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).Name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).Name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).Name = "entry_date"
-    tables(3).field(2).Name = "patients_with_geparins"
-    tables(3).field(3).Name = "patients_per_quarter"
-    tables(3).field(4).Name = "patients_stationar_nmg"
-    tables(3).field(5).Name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).Name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).Name = "entry_date"
-    tables(4).field(2).Name = "patients_with_geparins"
-    tables(4).field(3).Name = "patients_per_quarter"
-    tables(4).field(4).Name = "patients_stationar_nmg"
-    tables(4).field(5).Name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).Name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).Name = "entry_date"
-    tables(5).field(2).Name = "patients_per_quarter"
-    tables(5).field(3).Name = "risk_percent"
-    tables(5).field(4).Name = "patients_with_risk_ON"
-    tables(5).field(5).Name = "patients_ambulator"
-    tables(5).field(6).Name = "patients_ambulator_nmg"
-    tables(5).field(7).Name = "patients_ambulator_clexan"
-    tables(5).field(8).Name = "patients_stationar_nmg"
-    tables(5).field(9).Name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).Name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).Name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).Name) = getRS(tables(tbl_idx).field(fld_idx).Name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 10)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    tables_to_clear(9) = "quarter_rm"
-    tables_to_clear(10) = "reg_man"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-cdbPRJ
->>>>>>
-Attribute VB_Name = "cdbPRJ"
-Option Explicit
-
-Type tPROJECT
-    total_SALE  As Long ' ����� ����� ������
-    total_BDGT  As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU   As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_RM    As Long ' ����� �����
-    total_BEDS  As Long ' ����� ����� ����
-    total_HIR   As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER   As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS   As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN   As Long '  ���� ������ ��������
-    objRGN() As tREGION
-End Type
-
-Function GetPRJ_COMM_DATA(ByRef prj_data As tPROJECT) As Integer
-    Dim i As Integer
-    i = GetRGN_COMM_DATA(prj_data.objRGN, 0)
-    GetPRJ_COMM_DATA = i
-    If i > 0 Then
-        With prj_data
-            .sale_PLAN = 0
-            .total_ACS = 0
-            .total_BDGT = 0
-            .total_BDGT_NMG = 0
-            .total_BEDS = 0
-            .total_HIR = 0
-            .total_LPU = 0
-            .total_REP = 0
-            .total_RM = 0
-            .total_SALE = 0
-            .total_TER = 0
-            For i = 1 To UBound(prj_data.objRGN)
-                
-            Next i
-        End With
-    End If
-
-End Function
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-        .setEnt_date (getEnt_date())
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("RM_ID") = rm_id
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    Dim rm_struc As tREGMAN
-    
-    i = Range("RM_ID")
-    rm_struc = Get_REGMAN_Record(i)
-    
-    Range("C4") = rm_struc.LastName
-    Range("C5") = rm_struc.FirstName
-
-    Range("G5") = GetRegionName(rm_struc.Region)
-    
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date, Range("RM_ID"))
-
-    
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_LIST")
-        s = .Range("C5") & " " & .Range("C4") & ", " & .Range("G5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("REP_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date, rm_id)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id, allREPID(i).rm_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    rm_id As Long
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION, rm_id As Long) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date, rm_id)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_REP_count As Integer
-            reg_data(i).rm_id = rm_id
-            reg_data(i).ent_date = q_date(i)
-            current_REP_count = getREGION_by_QTR(q_date(i), reg_data(i), rm_id)
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-' if rm_id = 0 then gets all records
-Function getAllQTRNames(ByRef qtr_lst() As String, rm_id As Long) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    
-    If rm_id <> 0 Then
-        sql = sql & " WHERE rm_id=" & rm_id
-    End If
-    
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION, rm_id As Long) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tQTR_COMMON
-    rep_count = Get_QTR_CommonList_by_REP(reps, ent_date, 0, rm_id)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .c_bdgt_NFG + .c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtr.sale_PLAN
-                treg.total_SALE = treg.total_SALE + .c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .c_pat_HIR
-                treg.total_TER = treg.total_TER + .c_pat_TER
-                treg.total_ACS = treg.total_ACS + .c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .i_lcd
-                treg.total_BEDS = treg.total_BEDS + .c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-'            def_dir = GetWBPath(ThisWorkbook.FullName)
-'            If GetImportDirectory(def_dir, flist) Then
-'                Dim db_list() As String
-'                i = GetDBList(flist, db_list)
-'                If i > 0 Then
-'                    ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-'                End If
-'            End If
-'            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Range("ret_addr") = "RM_QTR"
-            Worksheets("REP_LIST").setEnt_date (Worksheets(RM_QTR_SHEET).getEnt_date())
-            Worksheets("REP_LIST").Range("RM_ID") = Worksheets(RM_QTR_SHEET).Range("RM_ID")
-            Worksheets("REP_LIST").Range("VIEW_ONLY") = True
-
-            Worksheets("REP_LIST").Select
-        Case 3
-            MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub btRM_QTR_RET_IT()
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cPPReport
->>>>>>
-Attribute VB_Name = "cPPReport"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Const PPR_NON As Integer = 0
-Const PPR_NEW As Integer = 1
-Const PPR_OLD As Integer = 2
-
-Dim ReportApp As PowerPoint.Application
-Dim ReportDoc As PowerPoint.Presentation
-Dim ReportState As Integer
-Dim PowerPointPath As String
-
-Private Sub Class_Initialize()
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    PowerPointPath = ReportApp.Path & "\PowerPNT.EXE"
-    ReportState = PPR_NON
-End Sub
-
-Sub OpenReport(FileName As String)
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = GetObject(FileName)
-    ReportState = PPR_OLD
-End Sub
-
-Sub CreateReport()
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = ReportApp.Presentations.Add
-    ReportState = PPR_NEW
-End Sub
-
-Sub SaveReport()
-    Select Case ReportState
-        Case PPR_NEW
-            ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME
-        Case PPR_OLD
-            ReportDoc.Save
-    End Select
-    ReportState = PPR_NON
-End Sub
-
-Sub ReportView()
-    Dim CmdName As String
-    CmdName = GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME + ".PPT"
-    CmdName = PowerPointPath & " " & CmdName
-    Shell CmdName, 1
-End Sub
-
-Sub InsertSlide()
-    Dim ReportPage As PowerPoint.Slide
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.count + 1, ppLayoutBlank)
-    
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = "Slide #" & Format(ReportDoc.Slides.count)
-End Sub
-
-
-Private Sub Class_Terminate()
-    SaveReport
-    ReportApp.Quit
-End Sub
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{36355920-F7A4-44A8-96EF-5D79CF26137D}{F852BDF2-AB3E-468E-89DF-EC5DC0C7C88B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-rmImport
->>>>>>
-Attribute VB_Name = "rmImport"
-Option Explicit
-
-Public Type dbDESCRIPTION
-    Name As String
-    Fields() As String
-End Type
-
-Sub ImportFromRegionalManagers(rm_files() As String, fm_file As String)
-    Dim db(9) As dbDESCRIPTION
-    
-    '''''data
-    db(1).Name = "rep"
-    
-    db(2).Name = "lpu"
-    db(3).Name = "lpu_acs"
-    db(4).Name = "lpu_budget"
-    db(5).Name = "lpu_hir"
-    db(6).Name = "lpu_im"
-    db(7).Name = "lpu_ter"
-    db(8).Name = "quarter"
-    db(9).Name = "quarter_rm"
-    
-    ReDim db(1).Fields(5)
-    With db(1)
-        .Fields(1) = "rep_id"
-        .Fields(2) = "firstname"
-        .Fields(3) = "lastname"
-        .Fields(4) = "region"
-        .Fields(5) = "city"
-    End With
-    
-    ReDim db(2).Fields(5)
-    With db(2)
-        .Fields(1) = "id"
-        .Fields(2) = "rep_id"
-        .Fields(3) = "name"
-        .Fields(4) = "address"
-        .Fields(5) = "beds"
-    End With
-    
-    ReDim db(3).Fields(7)
-    With db(3)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(4).Fields(6)
-    With db(4)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "bdgt_NMG"
-        .Fields(5) = "bdgt_NFG"
-        .Fields(6) = "sale_PLAN"
-    End With
-    
-    ReDim db(5).Fields(15)
-    With db(5)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "operations_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_ambulator_clexan_40mg"
-        .Fields(11) = "patients_ambulator_clexan_20mg"
-        .Fields(12) = "patients_stationar_nmg"
-        .Fields(13) = "patients_stationar_clexan"
-        .Fields(14) = "patients_stationar_clexan_40mg"
-        .Fields(15) = "patients_stationar_clexan_20mg"
-    End With
-    
-    
-    ReDim db(6).Fields(7)
-    With db(6)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(7).Fields(11)
-    With db(7)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_stationar_nmg"
-        .Fields(11) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(8).Fields(9)
-    With db(8)
-        .Fields(1) = "ID"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "rep_id"
-        .Fields(4) = "sale_plan"
-        .Fields(5) = "ClxnH20mg"
-        .Fields(6) = "ClxnH40mg"
-        .Fields(7) = "ClxnT40mg"
-        .Fields(8) = "ClxnC_IM"
-        .Fields(9) = "ClxnC_ACS"
-    End With
-    
-    ReDim db(9).Fields(3)
-    With db(9)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "sale_plan"
-    End With
-    
-    Dim rm_idx As Integer
-    Dim to_db As Object
-    'back uo
-    Merge_BackUp_All_Data
-    
-    'clean up
-    Merge_Clear_All_Data fm_file
-    
-    Set to_db = dbGetConnection(fm_file)
-    
-    For rm_idx = 1 To UBound(rm_files)
-        Dim from_db As Object
-        
-        Set from_db = dbGetConnection(rm_files(rm_idx))
-        
-        Dim new_rm_id As Long
-        new_rm_id = dbMergeRM(from_db, to_db)
-
-        Dim i As Integer
-
-        For i = 1 To UBound(db)
-            Dim get_sql As String
-            Dim getRS As Object
-            Dim insRS As Object
-            Dim field_idx As Integer
-                        
-            get_sql = "SELECT * FROM " & db(i).Name
-            Set getRS = CreateObject("ADODB.Recordset")
-            Set insRS = CreateObject("ADODB.Recordset")
-            insRS.Open db(i).Name, to_db, 2, 2
-
-            getRS.Open get_sql, from_db
-            
-            If Not getRS.BOF Then
-                Do While Not getRS.EOF
-                    insRS.addnew
-                    Dim fld_name As String
-                    
-                    For field_idx = 1 To UBound(db(i).Fields)
-                        fld_name = db(i).Fields(field_idx)
-                        insRS(fld_name) = getRS(fld_name)
-                    Next field_idx
-                    
-                    insRS("rm_id") = new_rm_id
-                    insRS.Update
-                    getRS.MoveNext
-                Loop
-            
-            Else
-                'empty table
-                ' do nothing
-            End If
-            
-            
-        Next i
-        
-        dbCloseOpenedConnection from_db
-    Next rm_idx
-    
-    dbCloseOpenedConnection to_db
-End Sub
-
-Function dbMergeRM(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM reg_man"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about Regional Manager! This database cannot be merged!!!"
-            dbMergeRM = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "reg_man", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    dbMergeRM = insertRecordset("mgr_id")
-    
-End Function
-
-Sub cmDataImport()
-    Dim def_dir As String
-    Dim flist() As String
-    Dim i As Integer
-
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        
-        If i > 0 Then
-            ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-        End If
-    End If
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-
-<<<<<<
-======================
-PRJ_QTR
->>>>>>
-Attribute VB_Name = "PRJ_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CPRJ_QT As Integer = 0
-Const CPRJ_ID As Integer = 1
-Const CPRJ_PLN As Integer = 2
-Const CPRJ_FCT As Integer = 3
-Const CPRJ_BDG As Integer = 4
-Const CPRJ_CNT As Integer = 5
-Const CPRJ_BEDS As Integer = 6
-Const CPRJ_HIR As Integer = 7
-Const CPRJ_TER As Integer = 8
-Const CPRJ_CRD As Integer = 9
-Const CPRJ_CLXN_BDG As Integer = 10
-Const CPRJ_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("PRJ_QTR")
-        s = "��� �������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tREGION
-    Dim i As Long
-    Dim r As Range
-
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objQTR(), 0)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CPRJ_QT) = objQTR(i).ent_date
-            r.Offset(i - 1, CPRJ_ID) = ""
-            r.Offset(i - 1, CPRJ_PLN) = objQTR(i).sale_PLAN
-            r.Offset(i - 1, CPRJ_FCT) = objQTR(i).total_SALE
-            r.Offset(i - 1, CPRJ_BDG) = objQTR(i).total_BDGT
-            r.Offset(i - 1, CPRJ_CNT) = objQTR(i).total_LPU
-            r.Offset(i - 1, CPRJ_BEDS) = objQTR(i).total_REP
-            r.Offset(i - 1, CPRJ_HIR) = objQTR(i).total_HIR
-            r.Offset(i - 1, CPRJ_TER) = objQTR(i).total_TER
-            r.Offset(i - 1, CPRJ_CRD) = objQTR(i).total_ACS
-            If objQTR(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_BDG) = objQTR(i).total_SALE / objQTR(i).total_BDGT
-            End If
-            If objQTR(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_NMG) = objQTR(i).total_SALE / objQTR(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CPRJ_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_CLXN_NMG + 1)
-        End If
-    Next i
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Public Sub cbxPRJ_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_PRJ
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_PRJ
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_PRJ
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = PRJ_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CPRJ_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "PRJ_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btPRJ_QTR_Do_IT ' old btRM_OTR_DO_IT
-End Sub
-
-<<<<<<
-======================
-RM_LIST
->>>>>>
-Attribute VB_Name = "RM_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentRM_ID() As Long
-    Dim r As Range
-
-    With Worksheets("RM_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CRM_ID)
-    End With
-
-    getCurrentRM_ID = r
-End Function
-
-Public Sub RM_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("PM_CHR_IDX")
-        Case 1
-            Rm_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rm_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rm_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-
-        Case 4
-            Rm_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectRM_QTR(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "RM_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("RM_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Public Sub SelectREP_LIST(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "REP_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .setEnt_date (getEnt_date())
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateRMList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Sub UpdateRMList()
-    Dim rmcd() As tRMID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_RM_CommonList_by_QTR(rmcd(), ent_date)
-
-    With ThisWorkbook.Worksheets("RM_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rmcd)
-            r.Offset(i - 1, CRM_NAME) = GetRegionName(rmcd(i).rm.Region)
-            r.Offset(i - 1, CRM_ID) = rmcd(i).rm.rm_id
-            r.Offset(i - 1, CRM_BEDS) = rmcd(i).rgcd(1).total_BEDS
-            r.Offset(i - 1, CRM_BDGT) = rmcd(i).rgcd(1).total_BDGT
-            r.Offset(i - 1, CRM_NMG) = rmcd(i).rgcd(1).total_BDGT_NMG
-            r.Offset(i - 1, CRM_HIR) = rmcd(i).rgcd(1).total_HIR
-            r.Offset(i - 1, CRM_TER) = rmcd(i).rgcd(1).total_TER
-            r.Offset(i - 1, CRM_CAR) = rmcd(i).rgcd(1).total_ACS
-            r.Offset(i - 1, CRM_FACT) = rmcd(i).rgcd(1).total_SALE
-            r.Offset(i - 1, CRM_PLAN) = rmcd(i).rgcd(1).sale_PLAN
-            
-            With rmcd(i).rgcd(1)
-                r.Offset(i - 1, CRM_PAT_LPU) = .total_HIR + .total_TER + .total_ACS
-            End With
-            
-            r.Offset(i - 1, CRM_BDGT_1) = rmcd(i).rgcd(1).total_BDGT
-            If rmcd(i).rgcd(1).total_BDGT > 0 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = rmcd(i).rgcd(1).total_SALE / rmcd(i).rgcd(1).total_BDGT
-            End If
-            If r.Offset(i - 1, CRM_BDGT_1 + 1) > 1 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CRM_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CRM_AREA).row, CRM_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CRM_AREA).Column
-
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CRM_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CRM_NAME
-        Range("JUMP") = ""
-    Else
-        btRM_LIST_DO_IT
-    End If
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-<<<<<<
-======================
-mPRJ_QTR
->>>>>>
-Attribute VB_Name = "mPRJ_QTR"
-Sub btPRJ_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("PRJ_ACTION")
-    ent_date = Worksheets(PRJ_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            cmDataImport
-        Case 2
-            Worksheets("RM_LIST").setEnt_date (Worksheets("PRJ_QTR").getEnt_date())
-            Worksheets("RM_LIST").Range("ret_addr") = "PRJ_QTR"
-            Worksheets("RM_LIST").Select
-        Case 3
-            cmNewReport
-    End Select
-    Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-End Sub
-
-
-<<<<<<
-======================
-mRM_LIST
->>>>>>
-Attribute VB_Name = "mRM_LIST"
-Option Explicit
-
-Public Const CRM_AREA As String = "B12"
-Public Const CRM_NAME As Integer = 0
-Public Const CRM_NAME1 As Integer = 1
-Public Const CRM_NAME2 As Integer = 2
-Public Const CRM_ID As Integer = 3
-Public Const CRM_BEDS As Integer = 4
-Public Const CRM_BDGT As Integer = 5
-Public Const CRM_NMG As Integer = 6
-Public Const CRM_HIR As Integer = 7
-Public Const CRM_TER As Integer = 8
-Public Const CRM_CAR As Integer = 9
-Public Const CRM_FACT As Integer = 10
-Public Const CRM_PLAN As Integer = 11
-Public Const CRM_PAT_LPU As Integer = 16
-Public Const CRM_BDGT_1 As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(CRM As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_LIST")
-        s = "�������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub Rm_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub Rm_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CRM_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub btRM_LIST_RET_IT()
-    With Worksheets("RM_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "PRJ_QTR"
-    End With
-    ThisWorkbook.Worksheets("PRJ_QTR").Activate
-End Sub
-
-
-Sub btRM_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rm_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("RM_LIST_ACTION")
-    With Worksheets("RM_LIST")
-        rm_id = .getCurrentRM_ID()
-        
-        Select Case i
-            Case 1:
-                .SelectRM_QTR rm_id
-            Case 2:
-                .SelectREP_LIST rm_id
-            End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-
-<<<<<<
-Project Name : 'ClexaneMR'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).ClearRepName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(REP_QTR_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-Const CQTR_PAT_ALL As Integer = 16
-Const CQTR_BDGT_ALL As Integer = 17
-
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRepName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-    Range("H5") = ""
-End Sub
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREP
-    
-    cRep = GetREPRecord
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-    
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    i = GetAll_QTR_Records(objQTR, "%")
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList(qcd)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_plan
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_BBL_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-
-Private Sub Worksheet_Activate()
-  
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-    
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CRow_Width Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-    
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub DO_New_qtr()
-    Dim res As Variant
-    Dim objQTR As tQTR
-    Dim s As String
-    s = GetLastQtr
-    objQTR.entry_date = GetNextQTR(s)
-    
-    If objQTR.entry_date = "" Then
-        Exit Sub
-    End If
-    
-    DO_Price_qtr objQTR.entry_date
-
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        Dim qtr As tQTR
-        Dim res As Integer
-        
-        qtr = Get_QTR_Record(ent_date)
-        
-        If qtr.id = 0 Then
-            qtr.entry_date = ent_date
-    
-            With Worksheets(VAR_SHEET)
-                qtr.ClxnH20mg = .Range("ClxnH20mg")
-                qtr.ClxnH40mg = .Range("ClxnH40mg")
-                qtr.ClxnT40mg = .Range("ClxnT40mg")
-                qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-                qtr.ClxnC_IM = .Range("ClxnC_IM")
-            End With
-        End If
-        
-        Dim dlg_nq As dlg_nextQTR
-        Set dlg_nq = New dlg_nextQTR
-        
-        With dlg_nq
-            .tb_qtr_name = qtr.entry_date
-            .tb_bdgt_avts = qtr.sale_plan
-            .tb_qtr_name = qtr.entry_date
-            .tb_ClxnH20mg = qtr.ClxnH20mg
-            .tb_ClxnH40mg = qtr.ClxnH40mg
-            .tb_ClxnT40mg = qtr.ClxnT40mg
-            .tb_ClxnC_ACS = qtr.ClxnC_ACS
-            .tb_ClxnC_IM = qtr.ClxnC_IM
-        End With
-        
-        dlg_nq.Show
-        res = dlg_nq.Tag
-        
-        If res = vbOK Then
-            With dlg_nq
-                If Not IsNumeric(.tb_bdgt_avts) Then
-                    MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                Else
-                    If .tb_bdgt_avts = 0 Then
-                        MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                        Exit Sub
-                    End If
-                End If
-                Dim bool As Boolean
-                bool = IsNumeric(.tb_ClxnH20mg) _
-                    And IsNumeric(.tb_ClxnH40mg) _
-                    And IsNumeric(.tb_ClxnT40mg) _
-                    And IsNumeric(.tb_ClxnC_ACS) _
-                    And IsNumeric(.tb_ClxnC_IM)
-                If Not bool Then
-                    MsgBox "������� ��������� �����", vbOK, PROGRAM_NAME
-                    Exit Sub
-                End If
-                qtr.sale_plan = .tb_bdgt_avts
-                qtr.entry_date = .tb_qtr_name
-                qtr.ClxnH20mg = .tb_ClxnH20mg
-                qtr.ClxnH40mg = .tb_ClxnH40mg
-                qtr.ClxnT40mg = .tb_ClxnT40mg
-                qtr.ClxnC_ACS = .tb_ClxnC_ACS
-                qtr.ClxnC_IM = .tb_ClxnC_IM
-            End With
-            Insert_QTR_Record qtr
-        End If
-    End If
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = False
-            .Range("ent_date") = ent_date
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        Dim i As Integer
-        i = MsgBox("������� ������ �� ������ [" & ent_date & "]?", vbDefaultButton2 + vbOKCancel, PROGRAM_NAME)
-        If i = vbOK Then
-            Dim objQTR As tQTR
-            If ent_date <> "" Then
-                objQTR.entry_date = ent_date
-                objQTR = Get_QTR_Record(ent_date)
-                Delete_QTR_Record objQTR
-                Worksheets(TITLE_SHEET).Select
-                Worksheets(REP_QTR_SHEET).Select
-            End If
-        End If
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            DO_New_qtr
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            dbExport
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    End Select
-    If idx <> 2 Then
-        With ThisWorkbook
-            .Worksheets(TITLE_SHEET).Select
-            .Worksheets(REP_QTR_SHEET).Select
-        End With
-    End If
-End Sub
-
-Sub Delete_qtr()
-    Dim ent_date As String
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    DO_Delete_qtr ent_date
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[MR]"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-    
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-    
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-        
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-                   
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-       
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CINP_WIDTH Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-    
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-        
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    lpu_id = r
-    
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-    
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-    
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-            
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-        
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-        
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-        
-        Case Else
-            Range("JUMP") = ""
-    End Select
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-    
-    is_input_range = INPUT_NO
-    
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-    
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREP
-    
-    ' ent_date = "%" ' % - all records
-    ent_date = getEnt_date
-    
-    objQTR = Get_QTR_Record(ent_date)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-     
-    ' ������� ���
-    Range("C3:C4").ClearContents
-    cRep = GetREPRecord
-    
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_plan
-    
-
-    
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-        
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-            
-         
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_plan
-            
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-            
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{566B33D6-957A-43E4-8444-D8EA3889700C}{42EE65B8-F8C6-4F95-9F52-7738BF6FCEAD}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-    
-        Dim objHir As tHIRURGIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.Count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-        
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-    
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-            Application.ScreenUpdating = False
-            
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-            
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{EBA94131-180E-4709-A2A3-B60D48987620}{47A860A1-BF92-4EBB-A333-AB7E83FAB868}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_plan = Round(Range("F13").Value, 0)
-            
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_plan
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_plan <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("��������� ������� ��������?", vbYesNo, PROGRAM_NAME) Then
-                    Insert_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-    
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_plan
-    
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    objQTR = Get_QTR_Record(ent_date)
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-    
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-        
-        SetupData cLPU
-        
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case INPUT_CHECK
-            
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{E3F10C5A-A4B4-42FF-A2C9-6F8198210A07}{563D0F3D-F79D-48F1-AFE4-A2136809B982}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{137EDDE5-3DB4-4BAD-A245-324DC31ABB36}{3BD7159A-BF6C-403F-B3DF-4834FA9E4D92}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{8EB80D4C-3476-421A-A370-6332A07DE509}{A7542905-C9F8-4F39-AD67-B62A88F8F4E6}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREP
->>>>>>
-Attribute VB_Name = "mREP"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSetREPRecord
-    With Worksheets("REP_QTR")
-        .ClearRepName
-        .Range("REP_QTR_INPUT_DATA").ClearContents
-        .Range("QTR_SEL") = ""
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-        Worksheets("REP_QTR").Range("QTR_SEL") = ""
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cUser As tREP
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cUser = GetREPRecord()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cUser.Region
-        .Range("IDX_CITY") = cUser.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cUser.Region
-        .cbCity = cUser.City
-        .tbFName = cUser.FirstName
-        .tbLName = cUser.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cUser
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        SetREPRecord cUser
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_plan As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim SQL As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_plan = 0
-    End With
-        
-    
-    SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_plan = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_plan = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_plan
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_plan & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPU(allLPU() As tLPU) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPU = dbGetAllLPU(dbConnection, allLPU)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPUbyQTR(allLPU() As tLPU, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPUbyQTR = dbGetAllLPUbyQTR(dbConnection, allLPU, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objLPU.id = 0 then insert else update
-Sub Insert_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    If objLPU.id = 0 Then
-        dbInsert_LPU_Record dbConnection, objLPU
-    Else
-        dbUpdate_LPU_Record dbConnection, objLPU
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub Delete_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDelete_LPU_Record dbConnection, objLPU
-    dbCloseConnection dbConnection
-End Sub
-
-Sub Delete_LPU_RecordQTR(ByRef objLPU As tLPU, ent_date As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-    dbCloseConnection dbConnection
-    
-End Sub
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim SQL As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    SQL = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Sub dbInsert_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-  
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu", dbConnection, 2, 2
-    dbRecordset.addnew
-    dbRecordset("name") = objLPU.name
-    dbRecordset("address") = objLPU.address
-    dbRecordset("rep_id") = objLPU.rep_id
-    dbRecordset("beds") = objLPU.beds
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objLPU.id = dbRecordset("id")
-  
-End Sub
-
-Sub dbUpdate_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu SET " & _
-    "name='" & objLPU.name & "'," & _
-    "address='" & objLPU.address & "'," & _
-    "beds=" & objLPU.beds & "," & _
-    "rep_id=" & objLPU.rep_id& & _
-    " WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-
-Function dbGetAllLPU(dbConnection As Object, allLPU() As tLPU) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu"
-    getAll_LPU_SQL = "SELECT * FROM lpu"
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPU = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAllLPUbyQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim where As String
-    where = "WHERE lpu_budget.entry_date like '" & ent_date & "'"
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget " & where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & where & " AND lpu.id=lpu_budget.lpu_id"
-    
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPUbyQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Sub dbDelete_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu " & _
-    "WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Hir_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Ter_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_ACS_RecordsByLPU_ID dbConnection, objLPU.id
-    
-End Sub
-
-Sub dbDelete_LPU_RecordQTR(dbConnection As Object, ByRef objLPU As tLPU, ent_date As String)
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-End Sub
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-Option Explicit
-
-Public Type tREP
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetREPRecord() As tREP
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetREPRecord = dbGetREPRecord(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub SetREPRecord(cUser As tREP)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSetREPRecord dbConnection, cUser
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSetREPRecord()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSetREPRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGetREPRecord(dbConnection As Object) As tREP
-    
-    Dim SQL As String
-    Dim objREP As tREP
-    
-    objREP.FirstName = ""
-    objREP.LastName = ""
-    objREP.Region = 0
-    objREP.City = 0
-    SQL = "SELECT firstname, lastname, region, city FROM " & _
-          "rep"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREP.FirstName = dbRecordset("firstname")
-        objREP.LastName = dbRecordset("lastname")
-        objREP.Region = dbRecordset("region")
-        objREP.City = dbRecordset("city")
-        
-    End If
-    
-    dbGetREPRecord = objREP
-        
-End Function
-
-Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREP.FirstName & "', " & _
-    "'" & objREP.LastName & "', " & _
-    objREP.Region & ", " & _
-    objREP.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-End Sub
-
-Public Sub dbReSetREPRecord(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("REP_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-'                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = Double2Str(.risk_percent, 3)
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub test()
-    Dim s As String
-    Dim d As Single
-    d = 1235.6789
-    s = Format(d, "####0,00")
-    MsgBox s
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    Dim del_request As Integer
-    Dim allLPU() As tLPU
-    Dim lpu_count As Integer
-    Dim i As Integer
-    Dim tmp_LPU_List As Range
-    Dim tmp_LPU_List_Addr As String
-    Dim r_end As Range
-    Dim dlg As Dlg_lpu_card
-    
-    Set dlg = New Dlg_lpu_card
-    
-    lpu_count = GetAllLPU(allLPU)
-    With Worksheets(VAR_SHEET)
-        Set tmp_LPU_List = .Range("tmp_LPU_List")
-        Set r_end = .Range(tmp_LPU_List, tmp_LPU_List.End(xlDown))
-        Set r_end = .Range(r_end, r_end.End(xlToRight))
-        .Range(tmp_LPU_List, r_end).ClearContents
-    End With
-        
-    If lpu_count <> 0 Then
-        dlg.cbxLPU_List_Enable.Enabled = True
-        For i = 1 To UBound(allLPU)
-            tmp_LPU_List.Cells(i, 1) = allLPU(i).name
-            tmp_LPU_List.Cells(i, 2) = allLPU(i).address
-            tmp_LPU_List.Cells(i, 3) = allLPU(i).beds
-            tmp_LPU_List.Cells(i, 4) = allLPU(i).id
-        Next i
-    Else
-        dlg.cbxLPU_List_Enable.Enabled = False
-    End If
-    
-    tmp_LPU_List_Addr = Worksheets(VAR_SHEET).name & "!" & _
-            Worksheets(VAR_SHEET).Range(tmp_LPU_List, tmp_LPU_List.End(xlDown)).address
-
-    With dlg
-        .cbLPU_List.RowSource = tmp_LPU_List_Addr
-        .cbLPU_List.ListIndex = 0
-        .cbxLPU_List_Enable = False
-        .cbLPU_List.Enabled = False
-        If cLPU.id <> 0 Then
-            .cbxLPU_List_Enable.Enabled = False
-        Else
-            If lpu_count <> 0 Then
-                .cbxLPU_List_Enable.Enabled = True
-            Else
-                .cbxLPU_List_Enable.Enabled = False
-            End If
-        End If
-        .tb_lpu_name.Text = cLPU.name
-        .tb_lpu_address.Text = cLPU.address
-        .tbBedsCount = cLPU.beds
-
-        .Tag = vbCancel
-    End With
-    
-    dlg.Show
-    
-    If Not IsNumeric(dlg.Tag) Then
-        Exit Sub
-    End If
-    
-    If dlg.Tag = vbOK Then
-        Dim n As Variant
-        Dim test As Integer
-        test = 0
-        n = dlg.tbBedsCount.Value
-        If Not IsNumeric(n) Then
-            test = 1
-        Else
-            If n = 0 Then
-                test = 1
-            End If
-        End If
-        If test = 0 Then
-            
-            cLPU.name = dlg.tb_lpu_name.Text
-            cLPU.address = dlg.tb_lpu_address.Text
-            cLPU.beds = dlg.tbBedsCount.Value
-                                    
-            If cLPU.name = "" Or cLPU.address = "" Then
-                test = 2
-            End If
-        End If
-        Select Case test
-            Case 0
-                If dlg.cbxLPU_List_Enable.Value = True Then
-                    cLPU.id = tmp_LPU_List.Cells(dlg.cbLPU_List.ListIndex + 1, 4)
-                End If
-                Insert_LPU_Record cLPU
-                ' ��������� ������� ������ ��� ��� � ��������
-                Dim bdgt As tBUDGET
-                bdgt = Get_BDGT_Record(cLPU.id, ent_date)
-                ' ������ ���: ������� ������ ������ � lpu_budget
-                If bdgt.id = 0 Then
-                    bdgt.lpu_id = cLPU.id
-                    bdgt.entry_date = ent_date
-                    Insert_BDGT_Record bdgt
-                End If
-            Case 1
-                MsgBox "������� ��������� ���������� ������ ����� ��� 1!", vbOKOnly, PROGRAM_NAME
-            Case 2
-                MsgBox "������������ � ����� ��� �� ������ ���� �������!", vbOKOnly, PROGRAM_NAME
-        End Select
-    End If
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-    
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-    
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-    
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & "."
-        .Show
-        
-        If .Tag = vbOK Then
-            If .chbDeleteAll.Value Then
-                delete_all = _
-                    MsgBox("��� ������ �� ��� � ������ '" & cLPU.name & _
-                    "' ����� ������� ��������.", vbOK, PROGRAM_NAME)
-                If delete_all = vbOK Then
-                    Delete_LPU_Record cLPU
-                End If
-            Else
-                Delete_LPU_RecordQTR cLPU, ent_date
-            End If
-        End If
-    End With
-    
-    With ThisWorkbook
-        .Worksheets(TITLE_SHEET).Select
-        .Worksheets("LPU_LIST").Select
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Activate
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-        
-    
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id <> 0 And i = 1 Then
-            lpu_id = 0
-        End If
-        If lpu_id = 0 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1, 6
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                If lpu_id <> 0 Then
-                    .SelectLPU_BDGT lpu_id, ent_date
-                    .Range("JUMP") = "LPU_BDGT"
-                End If
-            Case 3
-                If lpu_id <> 0 Then
-                    .SelectLPU_HIR lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_HIR"
-                End If
-            Case 4
-                If lpu_id <> 0 Then
-                    .SelectLPU_TER lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_TER"
-                End If
-            Case 5
-                If lpu_id <> 0 Then
-                    .SelectLPU_C_ACS lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_C_ACS"
-                End If
-        End Select
-    End With
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_plan As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    Else
-        getLast_QTR_SQL = ""
-    End If
-    
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Sub Insert_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTR.id <> 0 Then
-        dbUpdate_QTR_Record dbConnection, objQTR
-    Else
-        dbInsert_QTR_Record dbConnection, objQTR
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTR_Record(ent_date As String) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, ent_date)
-    If i <> 0 Then
-        Get_QTR_Record = allQTR(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records(ByRef All_QTR() As tQTR, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTR_Records = dbGetAll_QTR_Records(dbConnection, All_QTR, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTR_Record dbConnection, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTR.ID <> 0 then updatre else insert
-Sub dbInsert_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTR
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_plan
-        dbRecordset("rep_id") = .rep_id
-        dbRecordset("ClxnH20mg") = .ClxnH20mg
-        dbRecordset("ClxnH40mg") = .ClxnH40mg
-        dbRecordset("ClxnT40mg") = .ClxnT40mg
-        dbRecordset("ClxnC_IM") = .ClxnC_IM
-        dbRecordset("ClxnC_ACS") = .ClxnC_ACS
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTR.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim Update_SQL As String
-    
-    With objQTR
-        Update_SQL = "UPDATE quarter SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rep_id=" & .rep_id & "," & _
-            "sale_plan=" & .sale_plan & "," & _
-            "ClxnH20mg=" & .ClxnH20mg & "," & _
-            "ClxnH40mg=" & .ClxnH40mg & "," & _
-            "ClxnT40mg=" & .ClxnT40mg & "," & _
-            "ClxnC_IM=" & .ClxnC_IM & "," & _
-            "ClxnC_ACS=" & .ClxnC_ACS & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTR_Records(dbConnection As Object, All_QTR() As tQTR, ent_date As String) As Integer
-    
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter WHERE entry_date like '" & ent_date & "'"
-    getAll_QTR_SQL = "SELECT * FROM quarter WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTR_Records = QTR_Count
-    
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim All_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_plan = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 All_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter " & _
-    "WHERE id=" & objQTR.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Hir_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Ter_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_ACS_RecordsByQTR dbConnection, objQTR.entry_date
-       
-End Sub
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList(ByRef qcd() As tQTR_COMMON) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList = dbGet_QTR_CommonList(dbConnection, qcd)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList(dbConnection As Object, ByRef qcd() As tQTR_COMMON) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, "%")
-    dbGet_QTR_CommonList = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_plan
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    On Error GoTo l_exit
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-l_exit:
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-        .EditDirectlyInCell = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{2FC04B4C-EB99-433E-ACDB-A920D02B9B5B}{777B85CC-ADE3-4188-94C8-9E07DA8B5076}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    On Error GoTo ExitLabel
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.Count
-                On Error Resume Next
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{3F7D7D75-90F6-4829-9E24-CA5391BB2A03}{A1A0F296-0D28-4123-8E38-82FA6EE6F2EF}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAllLPUbyQTR(dbConnection, allLPU, objQTR.entry_date)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-   
-    Unprotect
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-        
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{91AE5FA0-01C7-4C10-9E5F-D1D2DDF29401}{5726592A-BC0A-4E79-A963-35D354045716}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{FB055133-927F-41FF-BC90-442833A40591}{11BCAB43-1EDD-440B-AB0E-20CD6E42E11A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tID_REP
-    id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Public Type tID_REP_COMMON
-    id_rep As tID_REP
-    i_qtr As Long
-    qtrs As tQTR_COMMON
-End Type
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim last_qtr As String
-    
-    On Error GoTo ErrHandler
-    
-    last_qtr = GetLastQTR_fromDB
-    If last_qtr = "" Then
-        MsgBox "��� ������� � ���� ������. ������� ����������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & last_qtr & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub t()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-<<<<<<
-======================
-xTEST_NUM
->>>>>>
-Attribute VB_Name = "xTEST_NUM"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mSerialTNT
->>>>>>
-Attribute VB_Name = "mSerialTNT"
-Option Explicit
-Const MAX_NUM1 As Integer = ThirtySixBase
-Const MAX_NUM2 As Integer = ThirtySixBase ^ 2 / 2
-Const MAX_NUM3 As Integer = ThirtySixBase
-
-Const USERID_BASE As Long = ThirtySixBase ^ 3
-
-Const SRVC_BASE As Integer = 1000
-Const SRVC_MAX As Integer = 1999
-
-Const ORG_BASE As Integer = 100
-Const ORG_MAX As Integer = 199
-
-Sub test()
-    Dim user() As String
-    Dim i
-    Dim r As Range
-    Dim s As String
-    
-    Application.ScreenUpdating = False
-    
-    Dim calc_type As Integer
-    calc_type = Application.Calculation
-    Application.Calculation = xlCalculationManual
-   
-    Set r = Worksheets("TEST_SN").Range("B3")
-    For i = 0 To 50000
-        user = getNextSerial(1000, 100)
-        r = "'" & user(1)
-        r.Offset(0, 1) = "'" & user(2)
-        r.Offset(0, 2) = Len(user(1))
-        r.Offset(0, 3) = Len(user(2))
-        If i <> 0 Then
-            s = "=IF(" & r.Address & "=" & r.Offset(-1, 0).Address & ",1,0)"
-            r.Offset(0, 4).Formula = s
-        End If
-        Set r = r.Offset(1, 0)
-    Next i
-    
-    Application.Calculation = calc_type
-    Application.ScreenUpdating = False
-
-End Sub
-
-Function getNextSerial(srv As Integer, org As Integer) As String()
-    Dim num1 As Integer
-    Dim num2 As Integer
-    Dim num3 As Integer
-    Dim rdate As Long
-    Dim userID As Long
-    
-    num1 = nextNumber(MAX_NUM1)
-    num2 = nextNumber(MAX_NUM2)
-    num3 = nextNumber(MAX_NUM3)
-    
-    rdate = get_sn_date
-    
-    userID = nextUserID
-    
-    Dim serial As String
-    
-    serial = "" & srv & org & rdate & userID & num1 & num2 & num3
-    
-    Dim serial_SN As Integer
-    
-    serial_SN = get_serial_check_sum(serial)
-    
-    Dim login_1 As Long
-    Dim login_2 As Long
-    
-    Dim pass_1 As Long
-    Dim pass_2 As Long
-    
-    login_1 = "" & userID & serial_SN
-    login_2 = "" & num3 & rdate
-    
-    pass_1 = "" & num1 & srv
-    pass_2 = "" & num2 & org
-    
-    Dim out(2) As String
-    out(1) = Dec2ThirtySix(login_1) & Dec2ThirtySix(login_2)
-    out(2) = Dec2ThirtySix(pass_1) & Dec2ThirtySix(pass_2)
-    
-    getNextSerial = out
-End Function
-
-Function get_serial_check_sum(id_sn As String) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim chk As Integer
-    
-    s = id_sn
-    chk = 0
-    While s <> ""
-        i = Left(s, 1)
-        chk = (chk + i) Mod 10
-        s = Right(s, Len(s) - 1)
-    Wend
-    get_serial_check_sum = chk
-End Function
-
-Function get_sn_date() As Long
-    Dim d_date As Long
-    d_date = (Year(Now()) Mod 10)
-    d_date = d_date * 10000
-    d_date = d_date + Month(Now()) * 100
-    d_date = d_date + Day(Now())
-    get_sn_date = d_date
-End Function
-
-Function nextUserID() As Long
-    nextUserID = USERID_BASE + Int(Rnd() * USERID_BASE)
-End Function
-
-Function nextNumber(base As Integer) As Integer
-    nextNumber = base + Int(Rnd() * base)
-End Function
-
-Function serial_check_id_sum(id_sn As String) As Integer
-    Dim i As Integer
-    Dim s As String
-    Dim chk As Integer
-    
-    s = id_sn
-    chk = 0
-    While s <> ""
-        i = Left(s, 1)
-        chk = (chk + i) Mod 10
-        s = Right(s, Len(s) - 1)
-    Wend
-    serial_check_id_sum = chk
-End Function
-
-<<<<<<
-======================
-xTEST_SER
->>>>>>
-Attribute VB_Name = "xTEST_SER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Dec2TS
->>>>>>
-Attribute VB_Name = "Dec2TS"
-Option Explicit
-
-'Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-'Const ThirtySixBase As Integer = 36
-
-Public Const ThirtySixNumbers As String = "123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
-Public Const ThirtySixBase As Integer = 34
-
-Function randSN(Optional n As Integer = 34) As String
-    Dim t(ThirtySixBase) As String
-    Dim i As Integer
-    Dim j, k As Integer
-    Dim r As String
-    
-    For i = 1 To UBound(t)
-        t(i) = Mid(ThirtySixNumbers, i, 1)
-    Next i
-    For i = 1 To n
-        j = Int((ThirtySixBase * Rnd) + 1)
-        k = i Mod ThirtySixBase + 1
-        r = t(k)
-        t(k) = t(j)
-        t(j) = r
-    Next i
-    r = ""
-    For i = 1 To UBound(t)
-        r = r + t(i)
-    Next i
-    randSN = r
-End Function
-Function Dec2ThirtySix(ByVal Dec As Long) As String
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Double
-    
-    ThirtySixStr = TS
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If ThirtySixStr = "" Then
-        Dec = 0
-    Else
-        While ThirtySixStr <> ""
-            lastdigit = Right(ThirtySixStr, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            ThirtySixStr = Mid(ThirtySixStr, 1, Len(ThirtySixStr) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-
-Sub test()
-    Dim l As Long
-    l = ThirtySix2Dec("2HPI")
-    l = ThirtySix2ChkSum("2HPI")
-End Sub
-
-Function ThirtySix2ChkSum(TS As String) As Integer
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim chksum As Integer
-    
-    ThirtySixStr = TS
-
-    chksum = 0
-    
-    If ThirtySixStr = "" Then
-        chksum = 0
-    Else
-        While ThirtySixStr <> ""
-            lastdigit = Right(ThirtySixStr, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit) - 1
-            chksum = (chksum + idx) Mod ThirtySixBase
-            ThirtySixStr = Left(ThirtySixStr, Len(ThirtySixStr) - 1)
-        Wend
-    End If
-
-    ThirtySix2ChkSum = chksum
-End Function
-<<<<<<
-======================
-newItemDlg
->>>>>>
-Attribute VB_Name = "newItemDlg"
-Attribute VB_Base = "0{0B5E9521-7808-446E-9E61-7D38E1C2651A}{1C691B41-AC71-4558-927D-1487F1C50C72}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub AddSYS_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub resetSYS_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-<<<<<<
-======================
-Dec2Hex
->>>>>>
-Attribute VB_Name = "Dec2Hex"
-Option Explicit
-
-
-Const HexNumbers As String = "0123456789ABCDEF"
-Const HexBase As Integer = 16
-Const ThirtyNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRST"
-Const ThirtyBase As Integer = 30
-
-Function sDec2Hex(Dec As Long) As String
-    Dim HexStr As String
-    Dim idx As Integer
-    
-    HexStr = ""
-    
-    If Dec = 0 Then
-        HexStr = Mid(HexNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod HexBase
-            HexStr = Mid(HexNumbers, idx + 1, 1) + HexStr
-            Dec = Dec \ HexBase
-        Wend
-    End If
-    sDec2Hex = HexStr
-End Function
-
-Function Hex2Dec(HexString As String) As Long
-    Dim digit As Integer
-    Dim ch As String
-    Dim hexpower As Integer
-    Dim hexnum As String
-    Dim decnumber As Long
-    
-    hexnum = UCase(HexString)
-    hexpower = 0
-    decnumber = 0
-    
-    While hexnum <> ""
-        ch = Right(hexnum, 1)
-        hexnum = Left(hexnum, Len(hexnum) - 1)
-        digit = InStr(1, HexNumbers, ch, vbBinaryCompare)
-        decnumber = decnumber + digit ' power(hexbase, hexpower)
-        hexpower = hexpower + 1
-    Wend
-    Hex2Dec = decnumber
-End Function
-
-
-
-Function Dec2Thirty(Dec As Long) As String
-    
-    Dim ThirtyStr As String
-    Dim idx As Integer
-    
-    ThirtyStr = ""
-    
-    If Dec = 0 Then
-        ThirtyStr = Mid(ThirtyNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtyBase
-            ThirtyStr = Mid(ThirtyNumbers, idx + 1, 1) + ThirtyStr
-            Dec = Dec \ ThirtyBase
-        Wend
-    End If
-    Dec2Thirty = ThirtyStr
-End Function
-
-<<<<<<
-======================
-TEST_SN
->>>>>>
-Attribute VB_Name = "TEST_SN"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ETIME
->>>>>>
-Attribute VB_Name = "ETIME"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Function GetLinesCount(ByVal Location As Range) As Long
-    Dim n As Long
-    n = 0
-    Do While Location.Offset(n, 0) <> ""
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub hide_sheets()
-    Dim ws As Worksheet
-    Dim wsname As String
-    For Each ws In ThisWorkbook.Worksheets
-        wsname = ws.Name
-        ws.Protect UserInterfaceonly:=True
-        If Left(wsname, 1) = "x" Then
-            ws.EnableCalculation = False
-            ws.Visible = xlSheetVeryHidden
-        End If
-    Next ws
-End Sub
-
-Sub show_sheets()
-    Dim ws As Worksheet
-    Dim wsname As String
-    For Each ws In ThisWorkbook.Worksheets
-        ws.Unprotect
-        wsname = ws.Name
-        If Left(wsname, 1) = "x" Then
-            ws.EnableCalculation = True
-            ws.Visible = xlSheetVisible
-        End If
-    Next ws
-End Sub
-
-Sub check_sn_seria()
-    Dim r1 As Range
-    Dim r2 As Range
-    Dim i As Long
-    Dim j As Long
-    
-    Dim calc_type As Integer
-    calc_type = Application.Calculation
-    Application.Calculation = xlCalculationManual
-    
-    Set r1 = Worksheets("OEM_100").Range("B7")
-    Set r2 = Worksheets("OEM_100").Range("C7")
-        
-    i = GetLinesCount(r1)
-    j = GetLinesCount(r2)
-    
-    Dim as1() As String
-    Dim as2() As String
-    
-    ReDim as1(i)
-    ReDim as2(j)
-    
-    i = 1
-    While r1 <> ""
-        as1(i) = r1
-        as2(i) = r2
-        Set r1 = r1.Offset(1, 0)
-        Set r2 = r2.Offset(1, 0)
-        i = i + 1
-    Wend
-    
-    Set r1 = Worksheets("OEM_100").Range("E6")
-    Set r2 = Worksheets("OEM_100").Range("E7")
-    
-    r1.EntireColumn.ClearContents
-    r1.Offset(0, 1).EntireColumn.ClearContents
-    r1.Select
-    
-    For i = 1 To UBound(as1)
-        r1 = i
-        For j = 1 To UBound(as2)
-            If as1(i) = as2(j) Then
-                r2 = i
-                r2.Offset(0, 1) = j
-                r1.Offset(0, 1) = r1.Offset(0, 1) + 1
-            End If
-        Next j
-    Next i
-    If r2.Row = 7 Then
-        r2 = ";-)"
-    End If
-    Application.Calculation = calc_type
-    Application.Calculate
-End Sub
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Sub Dom2_Stat()
-    Dim sr As Range
-    
-    Set sr = Worksheets("DOM2-Stat1w").Range("c7:e54")
-    
-    DelAllBlanks sr
-End Sub
-
-Sub Dom2_Stat2()
-    Dim sr As Range
-    
-    Set sr = Worksheets("DOM2-Stat2w").Range("e7:e92")
-    
-    DelAllPercentage sr
-End Sub
-
-Sub DelAllBlanks(ByRef r As Range)
-    Dim c As Range
-    Dim s_in As String
-    Dim s_out As String
-    Dim spaceIdx As Integer
-    
-    For Each c In r
-        s_in = c.Value2
-        s_out = Left(s_in, Len(s_in) - 4) + Right(s_in, 3)
-        c = s_out
-        c.NumberFormat = "###"
-    Next c
-End Sub
-
-Sub DelAllPercentage(ByRef r As Range)
-    Dim c As Range
-    Dim s_in As String
-    Dim s_out As String
-    Dim spaceIdx As Integer
-    
-    For Each c In r
-        s_in = c.Value2
-        s_in = Left(s_in, InStr(s_in, "(") - 2)
-        If Len(s_in) > 4 Then
-            s_out = Left(s_in, Len(s_in) - 4) + Right(s_in, 3)
-        Else
-            s_out = s_in
-        End If
-        c = s_out
-        c.NumberFormat = "###"
-    Next c
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Digit2String
->>>>>>
-Attribute VB_Name = "Digit2String"
-Sub main()
-
-Dim dd As Double
-Dim st As String
-
-dd = 21.2234
-
-' 0 - rub
-' 1 - y.e.
-
-st = Digit2String(dd, 1)
-
-End Sub
-
-Function Digit2String(digit As Double, p As Integer) As String
-
-' ������ ������� 18.06.01 mikle-2
-Dim W1(20) As String
-Dim W1a(20) As String
-Dim W10(10) As String
-Dim W100(10) As String
-Dim W1000(10) As String
-
-W1(0) = ""
-W1(1) = "����"
-W1(2) = "���"
-W1(3) = "���"
-W1(4) = "������"
-W1(5) = "����"
-W1(6) = "�����"
-W1(7) = "����"
-W1(8) = "������"
-W1(9) = "������"
-W1(10) = "������"
-W1(11) = "����������"
-W1(12) = "����������"
-W1(13) = "����������"
-W1(14) = "������������"
-W1(15) = "����������"
-W1(16) = "�����������"
-W1(17) = "����������"
-W1(18) = "������������"
-W1(19) = "������������"
-W1a(0) = ""
-W1a(1) = "����"
-W1a(2) = "���"
-W1a(3) = "���"
-W1a(4) = "������"
-W1a(5) = "����"
-W1a(6) = "�����"
-W1a(7) = "����"
-W1a(8) = "������"
-W1a(9) = "������"
-W1a(10) = "������"
-W1a(11) = "����������"
-W1a(12) = "����������"
-W1a(13) = "����������"
-W1a(14) = "������������"
-W1a(15) = "����������"
-W1a(16) = "�����������"
-W1a(17) = "����������"
-W1a(18) = "������������"
-W1a(19) = "������������"
-W10(0) = ""
-W10(1) = "������"
-W10(2) = "��������"
-W10(3) = "��������"
-W10(4) = "�����"
-W10(5) = "���������"
-W10(6) = "����������"
-W10(7) = "���������"
-W10(8) = "�����������"
-W10(9) = "���������"
-W100(0) = ""
-W100(1) = "���"
-W100(2) = "������"
-W100(3) = "������"
-W100(4) = "���������"
-W100(5) = "�������"
-W100(6) = "��������"
-W100(7) = "�������"
-W100(8) = "���������"
-W100(9) = "���������"
-
-Result = ""
-
-e = Int((digit - Int(digit)) * 100) ' decimal
-digit_long = Int(digit)
-a = Int(digit_long / 1000000) '32123456/1000000 = 32 -> 10^6
-b = digit_long - (a * 1000000) '32123456-32000000 = 123456
-c = Int(b / 1000) '123456/1000 = 123 -> 10^3
-d = b - (c * 1000) '123456-123*1000 = 456 -> 1
-
-Add = ""
-For i = 2 To 0 Step -1
-    m = Int(a / (10 ^ i))
-    If i = 2 Then
-        If m <> 0 Then
-            R = W100(m) + " "
-            Add = "��������� "
-        End If
-    End If
-    If i = 1 Then
-        If m <> 0 Then
-            If a < 20 Then
-                Result = Result + W1(a) + " ��������� "
-                GoTo con_0
-            End If
-            R = W10(m) + " "
-            Add = "��������� "
-        End If
-    End If
-    If i = 0 Then
-        If m <> 0 Then
-            If m >= 5 Then
-                R = W1(m) + " "
-                Add = "��������� "
-            End If
-            If m <= 4 Then
-                R = W1(m) + " "
-                Add = "�������� "
-            End If
-            If m = 1 Then
-                R = "���� "
-                Add = "������� "
-            End If
-        End If
-        
-    End If
-    a = a - (m * (10 ^ i))
-    Result = Result + R
-    R = ""
-Next i
-Result = Result + Add
-con_0:
-
-Add = ""
-For i = 2 To 0 Step -1
-    m = Int(c / (10 ^ i))
-    If i = 2 Then
-        If m <> 0 Then
-            R = W100(m) + " "
-            Add = "����� "
-        End If
-    End If
-    If i = 1 Then
-        If m <> 0 Then
-            If c < 20 Then
-                Result = Result + W1(c) + " ����� "
-                GoTo con_1
-            End If
-            R = W10(m) + " "
-            Add = "����� "
-        End If
-    End If
-    If i = 0 Then
-        If m <> 0 Then
-            If m >= 5 Then
-                R = W1(m) + " "
-                Add = "����� "
-            End If
-            If m <= 4 Then
-                R = W1(m) + " "
-                Add = "������ "
-            End If
-            If m = 2 Then
-                R = "��� "
-                Add = "������ "
-            End If
-            If m = 1 Then
-                R = "���� "
-                Add = "������ "
-            End If
-        End If
-    End If
-    c = c - (m * (10 ^ i))
-    Result = Result + R
-    R = ""
-Next i
-Result = Result + Add
-con_1:
-
-Add = ""
-For i = 2 To 0 Step -1
-    m = Int(d / (10 ^ i))
-    If i = 2 Then
-        If m <> 0 Then
-            R = W100(m) + " "
-        End If
-    End If
-    If i = 1 Then
-        If m <> 0 Then
-            If d < 20 Then
-                R = W1(d) + " "
-                Result = Result + R
-                GoTo con_2
-            End If
-            R = W10(m) + " "
-        End If
-    End If
-    If i = 0 Then
-        If m <> 0 Then
-            If p = 0 Then
-                R = W1(m) + " "
-            Else
-                R = W1a(m) + " "
-            End If
-        End If
-    End If
-    
-    d = d - (m * (10 ^ i))
-    Result = Result + R
-    R = ""
-Next i
-con_2:
-
-
-If p = 0 Then       ' rub
-    Result = Result + "���. "
-End If
-
-For i = 1 To 0 Step -1
-    m = Int(e / (10 ^ i))
-    Result = Result + Chr$(m + Asc("0"))
-    e = e - (m * (10 ^ i))
-Next i
-
-If p = 0 Then       ' rub
-    Result = Result + " ���."
-Else                ' y.e.
-    Result = Result + "/100 �.�"
-End If
-
-Result(1) = Result(1) + Chr(Asc("A")) - Chr(Asc("a"))
-
-Digit2String = Result
-
-End Function
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag lengthProject Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    Call CleanUp
-End Sub
-
-Private Sub Workbook_Open()
-    Call CreateFormBar
-    frmFaceID.Show
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-'Global variables hold preious choices
-'for begining and ending FaceID numbers
-Public glbLastFirstID As Long
-Public glbLastLastID As Long
-
-
-Function CBShowButtonFaceIDs(lngIDStart As Long, _
-                             lngIDStop As Long)
-    ' This procedure creates a toolbar with buttons that display the
-    ' images associated with the values starting at lngIDStart and
-    ' ending at lngIDStop.
-    
-    Dim cbrNewToolbar   As CommandBar
-    Dim cmdNewButton    As CommandBarButton
-    Dim intCntr         As Integer
-    
-    ' Delete existing ShowFaceIds toolbar if it exists.
-    On Error Resume Next
-    Application.CommandBars("ShowFaceIds").Delete
-    frmFaceID.MousePointer = fmMousePointerHourGlass
-    ' Create a new toolbar.
-    Set cbrNewToolbar = Application.CommandBars.Add _
-        (Name:="ShowFaceIds", temporary:=True)
-    
-    ' Create a new button with an image matching the FaceId property value
-    ' indicated by intCntr.
-    For intCntr = lngIDStart To lngIDStop
-        Set cmdNewButton = cbrNewToolbar.Controls.Add(Type:=msoControlButton)
-        With cmdNewButton
-            ' Setting the FaceId property value specifies the appearance
-            ' but not the functionality of the button.
-            .FaceId = intCntr
-            .Caption = "FaceId = " & intCntr
-        End With
-    Next intCntr
-    
-    ' Show the images on the toolbar.
-    With cbrNewToolbar
-        .Width = 600
-        .Left = 100
-        .Top = 200
-        .Visible = True
-    End With
-    frmFaceID.MousePointer = fmMousePointerDefault
-End Function
-
-
-
-Public Function Validate()
-Dim lngTempNumber As Long
-
-'Procedure to check data entered by user
-With frmFaceID
-'If the first number requested < last number
-'then reverse them and rationalize
-'display next time form opens
-    If .txtFirstID Or .txtLastID > 0 Then
-        If CLng(.txtFirstID) > CLng(.txtLastID) Then
-           lngTempNumber = .txtFirstID
-           .txtFirstID = .txtLastID
-           .txtLastID = lngTempNumber
-         glbLastFirstID = .txtFirstID
-         glbLastLastID = .txtLastID
-        End If
- 'Only allow 200 FaceIDs per operation
- 'Call procedure to create FaceID values
- 'Take form out of memory
- 
-        If (.txtLastID - .txtFirstID) <= 200 Then
-            Call CBShowButtonFaceIDs(.txtFirstID, .txtLastID)
-            Unload frmFaceID
-        Else
-            MsgBox "Please request less than 200 FaceID's ", , "FaceID Number Finder"
-        End If
-    Else
-            .txtFirstID.SetFocus
-    End If
-End With
-End Function
-
-Public Function CleanUp()
-    On Error Resume Next
-   
-    Application.CommandBars("ShowFaceIds").Delete
-    Application.CommandBars("ShowForm").Delete
-      
-        
-End Function
-
-Public Function CreateFormBar()
-    Dim cmdBar As CommandBar
-    Dim btnForm As CommandBarButton
-'Delete the object if it already exists
-    On Error Resume Next
-    Application.CommandBars("ShowForm").Delete
-'Set the commandbar object variable
-    Set cmdBar = Application.CommandBars.Add
-        cmdBar.Name = "ShowForm"
-'Add a button
-    With cmdBar.Controls
-        
-        Set btnForm = .Add(msoControlButton)
-        
-    End With
-'Set the new button's properties
-    With btnForm
-        .Style = msoButtonIconAndCaption
-        .Caption = "Show FaceId Finder Form"
-        .FaceId = 2104
-        .OnAction = "OpenForm"
-        .TooltipText = "Show FaceID Form"
-    End With
-  ' Made visible in the form terminate event
-
-End Function
-
-Public Function OpenForm()
-'OnAction event procedure of ShowForm toolbar
-    frmFaceID.Show
-End Function
-
-
-<<<<<<
-======================
-frmFaceID
->>>>>>
-Attribute VB_Name = "frmFaceID"
-Attribute VB_Base = "0{5F1D3654-0CF0-11D2-B619-00AA00BBB974}{5F1D3641-0CF0-11D2-B619-00AA00BBB974}"
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub cmdFaceId_Click()
-  
-  Dim strDefaultStatus As String
- 'Set up global variables with current requested values
-    glbLastFirstID = txtFirstID
-    glbLastLastID = txtLastID
- 'Detect current status bar value
- 'Set status bar message while FaceId's are generated
-    strDefaultStatus = Application.DisplayStatusBar
-    Application.DisplayStatusBar = True
-    Application.StatusBar = "Working on FaceID display please wait"
-    
-'Call validation procedure
-   
-    Call Validate
- 'Put Status bar back as it was
-    Application.DisplayStatusBar = False
-    Application.StatusBar = strDefaultStatus
-End Sub
-
-
-Private Sub txtFirstID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
-   'Test for non numeric entry then cancel or convert to long
-    If IsNumeric(txtFirstID) = False Then
-       txtFirstID = ""
-       Cancel = True
-    Else
-        txtFirstID = CLng(txtFirstID)
-    End If
-    
-End Sub
-
-
-Private Sub txtLastID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
-    'Test for non numeric entry then cancel or convert to long
-    If IsNumeric(txtLastID) = False Then
-       txtLastID = ""
-       Cancel = True
-    Else
-        txtLastID = CLng(txtLastID)
-    End If
-    
-End Sub
-
-Private Sub UserForm_Activate()
- 'Set up form with last requested values
- 'Make toolbar not visible
- On Error Resume Next
-    txtFirstID = glbLastFirstID
-    txtLastID = glbLastLastID
-    Application.CommandBars("ShowForm").Visible = False
-End Sub
-
-
-
-Private Sub UserForm_Terminate()
-    'Show toolbar if form is unloaded in
-    'Validate procedure of if X is clicked
-    Application.CommandBars("ShowForm").Visible = True
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Function GetRegion(idx As Integer) As String
-    GetRegion = Range("LST_REGIONS").Offset(i, 0)
-End Function
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Workbook_Activate()
-    Worksheets("Home").Select
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("C4:G30").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("D44:H59").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-PPExport
->>>>>>
-Attribute VB_Name = "PPExport"
-Option Explicit
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub ViewReport()
-    Dim ReportDoc As PowerPoint.Presentation
-    Set ReportDoc = GetObject(GetWBPath(ThisWorkbook.FullName) + "report.ppt")
-    ReportDoc.Application.Visible = True
-End Sub
-
-Sub CreateReportSlide(ReportDoc As PowerPoint.Presentation, Title As String)
-    Dim ReportPage As PowerPoint.Slide
-    
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.Count + 1, ppLayoutBlank)
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = Title
-End Sub
-
-Sub CreateReport()
-    Dim ReportApp As PowerPoint.Application
-    Dim ReportDoc As PowerPoint.Presentation
-    
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    Set ReportDoc = ReportApp.Presentations.Add
-    
-    Dim i As Integer
-    For i = 1 To 4
-        ThisWorkbook.Worksheets("Sheet" + Format(i)).ExportCopy
-        CreateReportSlide ReportDoc, "Create slide name #" + Format(i)
-    Next i
-    
-    ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + "report"
-    ReportApp.Quit
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Workbook_Activate()
-    Worksheets("Home").Select
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("C4:G30").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    Range("D44:H59").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-PPExport
->>>>>>
-Attribute VB_Name = "PPExport"
-Option Explicit
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Sub ViewReport()
-    Dim ReportDoc As PowerPoint.Presentation
-    Set ReportDoc = GetObject(GetWBPath(ThisWorkbook.FullName) + "report.ppt")
-    ReportDoc.Application.Visible = True
-End Sub
-
-Sub CreateReportSlide(ReportDoc As PowerPoint.Presentation, Title As String)
-    Dim ReportPage As PowerPoint.Slide
-    
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.Count + 1, ppLayoutBlank)
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = Title
-End Sub
-
-Sub CreateReport()
-    Dim ReportApp As PowerPoint.Application
-    Dim ReportDoc As PowerPoint.Presentation
-    
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    Set ReportDoc = ReportApp.Presentations.Add
-    
-    Dim i As Integer
-    For i = 1 To 4
-        ThisWorkbook.Worksheets("Sheet" + Format(i)).ExportCopy
-        CreateReportSlide ReportDoc, "Create slide name #" + Format(i)
-    Next i
-    
-    ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + "report"
-    ReportApp.Quit
-End Sub
-
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub ExportCopy()
-    ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-Sheet26
->>>>>>
-Attribute VB_Name = "Sheet26"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'Telfast_marketing'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    Set MyAppEvents.app = Application
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    If Application.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKCancel, "$" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close Savechanges:=False
-            Exit Sub
-        End If
-    End If
-    cmSetStandaloneMode
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    Dim res
-    res = MsgBox( _
-        prompt:="�� ������� ��������� ���������? �� ������ ��?", _
-        Buttons:=vbQuestion + vbYesNo, _
-        Title:=PROGRAM_NAME _
-    )
-    If res <> vbYes Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    
-    Dim NewFileName, DefFileName, WBPath As String
-    NewFileName = MakeNewFileName( _
-                        Worksheets("home").Range("USER_NAME_F"), _
-                        Worksheets("home").Range("USER_NAME_S"), _
-                        Worksheets("data").Range("CITY_TABLES") _
-                        .Offset( _
-                            Worksheets("data").Range("IDX_CITY"), _
-                            (Worksheets("data").Range("IDX_REGION") - 1) * 2 _
-                        ) _
-                    )
-    DefFileName = MakeNewFileName( _
-                        DEF_USER_NAME_F, _
-                        DEF_USER_NAME_S, _
-                        Worksheets("data").Range("CITY_TABLES") _
-                        .Offset(DEF_IDX_CITY, (DEF_IDX_REGION - 1) * 2) _
-                    )
-    WBPath = GetWBPath(ThisWorkbook.FullName)
-    
-    If ThisWorkbook.Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-        If ThisWorkbook.Saved = False Then
-            If NewFileName <> DefFileName Then
-                dlgFname.Caption = PROGRAM_NAME
-                dlgFname.lbFName = NewFileName
-                dlgFname.lbFPath = WBPath
-                dlgFname.Show
-                NewFileName = WBPath & NewFileName
-                ThisWorkbook.SaveAs FileName:=NewFileName
-            Else
-                ThisWorkbook.Save
-            End If
-        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars("Worksheet Menu Bar").Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-        Dim MaxX, MaxY As Integer
-        With ThisWorkbook.Worksheets(HOME_SHEET)
-            MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-            MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-        End With
-
-        With ThisWorkbook.Application
-            .ScreenUpdating = False
-            .WindowState = xlNormal
-            .Height = MaxY
-            .Width = MaxX
-        End With
-End Sub
-
-
-
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 1
-    Case INP_TXT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-
-    If is_InputRange(Target) <> INP_NO Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    Dim test As Boolean
-    
-    is_InputRange = INP_NO
-    
-    If r.Column = Range("USER_NAME_F").Column Then
-        test = r.Row = Range("USER_NAME_S").Row _
-                        Or r.Row = Range("USER_NAME_F").Row
-        If test Then
-            is_InputRange = INP_TXT
-        End If
-    Else
-        If r.Column = Range("USER_PLAN").Column Then
-            test = r.Row = Range("USER_PLAN").Row _
-                            Or r.Row = Range("USER_FACT").Row _
-                            Or r.Row = Range("USER_BUDGET").Row _
-                            Or r.Row = Range("USER_SVNORM").Row
-            
-            Dim idx As Integer
-            idx = Worksheets(DATA_SHEET).Range("IDX_PERSONE")
-            
-            If test Then
-                is_InputRange = INP_NUM
-            Else
-                If r.Row = Range("USER_STAF").Row Then
-                    If idx = 1 Then
-                        is_InputRange = INP_NUM
-                    End If
-                End If
-            End If
-        End If
-    End If
-End Function
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC As String = "C9"
-Const INP_APT As String = "C11"
-Const INP_ADV As String = "C13"
-Const INP_ACT As String = "C15"
-Const INP_VIP As String = "C17"
-Const INP_SUM As String = "C19"
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    
-    If is_InputRange(Target) Then
-        GoalSeekNow Range(INP_SUM), Target
-    Else
-        If Target.Row = Range(INP_SUM).Row And Target.Column = Range(INP_SUM).Column Then
-            Dim Addr As String
-            
-            Addr = INP_DOC & "," & INP_APT & "," & INP_ADV & "," & INP_ACT & "," & INP_VIP
-            RangeNormalize Range(Addr), Target
-            
-        End If
-    End If
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.2
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range(INP_DOC).Column _
-                And ( _
-                    r.Row = Range(INP_DOC).Row _
-                    Or r.Row = Range(INP_APT).Row _
-                    Or r.Row = Range(INP_ADV).Row _
-                    Or r.Row = Range(INP_ACT).Row _
-                    Or r.Row = Range(INP_VIP).Row _
-                )
-End Function
-
-
-<<<<<<
-======================
-mHome
->>>>>>
-Attribute VB_Name = "mHome"
-Option Explicit
-
-Sub cboxPersone_Change()
-    With ThisWorkbook.Worksheets(HOME_SHEET)
-        Dim r As Range
-        Range("A1").Select
-        If .Shapes("cboxPersone").ControlFormat.ListIndex = 2 Then
-            .Unprotect
-            .Range("G15") = 1
-            If Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-                .Protect
-            End If
-        End If
-    End With
-End Sub
-
-Sub cboxArea_Change()
-    Dim GroupIdx, LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    With ThisWorkbook.Worksheets(DATA_SHEET)
-        GroupIdx = .Range("IDX_REGION")
-        .Range("IDX_CITY") = 1
-        NewRangeOffsetCol = (GroupIdx - 1) * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).Address
-        NewSumRange = .Name & "!" & .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).Address
-    End With
-    With ThisWorkbook.Worksheets(HOME_SHEET)
-        .Shapes("cboxCity").ControlFormat.ListFillRange = NewCbxRange
-        .Unprotect
-        .Range("G10").Formula = "=sum(" & NewSumRange & ")"
-        If Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-            .Protect
-        End If
-    End With
-End Sub
-
-Sub cboxCity_Change()
-    
-End Sub
-
-<<<<<<
-======================
-mCommands
->>>>>>
-Attribute VB_Name = "mCommands"
-Option Explicit
-
-Sub btHome_Click()
-    Worksheets(HOME_SHEET).Select
-    Worksheets(DATA_SHEET).Range("CUR_STATE") = 0
-End Sub
-
-Sub bt2Budget_Click()
-    Sheets("budget").Select
-End Sub
-
-
-Sub btBdgtPrev_Click()
-    btHome_Click
-End Sub
-
-Sub btBdgtNext_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Final").Select
-    End If
-End Sub
-
-Sub btDoc_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Doc").Select
-    End If
-End Sub
-
-Sub btDocVisit_Click()
-    Sheets("Doc.Visit").Select
-End Sub
-
-Sub btDocConf_Click()
-    Sheets("Doc.Conf").Select
-End Sub
-
-Sub btApt_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Apt").Select
-    End If
-End Sub
-
-Sub btAptVisit_Click()
-    Sheets("Apt.Visit").Select
-End Sub
-
-
-Sub btAptConf_Click()
-    Sheets("Apt.Conf").Select
-End Sub
-
-Sub btAdv_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Adv").Select
-    End If
-End Sub
-
-Sub btAdvPrev_Click()
-    If check_Adv Then
-        bt2Budget_Click
-    End If
-End Sub
-
-Sub btAct_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Act").Select
-    End If
-End Sub
-
-Sub btCost_Click()
-    If check_budget(Range("BDGT_TOTAL")) Then
-        Sheets("Cost").Select
-    End If
-End Sub
-
-Sub btCostPrev_Click()
-    If check_budget(Range("Cost!C17")) Then
-        Sheets("budget").Select
-    End If
-End Sub
-
-<<<<<<
-======================
-Sheet40
->>>>>>
-Attribute VB_Name = "Sheet40"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.7
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range("C9").Column _
-                    And r.Row = Range("C9").Row
-End Function
-
-
-<<<<<<
-======================
-Tools
->>>>>>
-Attribute VB_Name = "Tools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub test()
-    Dim str As String
-    str = GetWBPath(ThisWorkbook.FullName)
-End Sub
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-Attribute SetDesignFlagOn.VB_ProcData.VB_Invoke_Func = "E\n14"
-    Dim Sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each Sh In Worksheets
-        Sh.Unprotect
-        Sh.Visible = xlSheetVisible
-    Next Sh
-    Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-Attribute SetDesignFlagOff.VB_ProcData.VB_Invoke_Func = " \n14"
-    Application.ScreenUpdating = False
-    Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim Sh As Worksheet
-    For Each Sh In Worksheets
-        If Sh.Name <> "data" Then
-            Sh.Protect
-        Else
-            Sh.Visible = xlSheetVeryHidden
-        End If
-    Next Sh
-    Application.ScreenUpdating = True
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma training"
-Public Const PROGRAM_VERSION As String = "version 1.0"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "N35"
-Public Const CITY_TABLES As String = "N30"
-
-
-Public Const DATA_SHEET As String = "data"
-
-' �������� ����� Home
-Public Const DEF_USER_NAME_F As String = "����"
-Public Const DEF_USER_NAME_S As String = "��������"
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Public Const HOME_SHEET As String = "Home"
-Public Const USER_NAME_F As String = "USER_NAME_F"
-Public Const USER_NAME_S As String = "USER_NAME_S"
-Public Const USER_PLAN As String = "USER_PLAN"
-Public Const USER_BUDGET As String = "USER_BUDGET"
-Public Const USER_FACT As String = "USER_FACT"
-
-' �������� ����� Adv
-Public Const ADV_SHEET As String = "Adv"
-Public Const ADV_SUM_CAP As String = "K9"
-Public Const ADV_SUM_DOC As String = "C17"
-Public Const ADV_SUM_APT As String = "E17"
-Public Const ADV_SUM_CAST As String = "G17"
-Public Const ADV_SUM_DIST As String = "I17"
-
-
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{81B9D41B-89F6-4B17-9F1D-45017FFC6C8F}{EF972C75-B6C6-407C-BAF6-74472541F2BB}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{0D5199B4-A753-4F74-A564-40388FABC4B0}{19DC56E2-E0F4-44B4-8B23-51B77A2564D5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-Sheet52
->>>>>>
-Attribute VB_Name = "Sheet52"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTDATE_LT As String = "B11"
-Const INPUTDATE_RB As String = "B25"
-Const INPUTTEXT_LT As String = "C11"
-Const INPUTTEXT_RB As String = "C25"
-Const INPUTNUMB_LT As String = "F11"
-Const INPUTNUMB_RB As String = "I25"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("B11").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTDATE_LT), Range(INPUTDATE_RB)) Then
-        is_InputRange = INP_DAT
-    Else
-        If is_InputArea(r, Range(INPUTTEXT_LT), Range(INPUTTEXT_RB)) Then
-            is_InputRange = INP_TXT
-        Else
-            If is_InputArea(r, Range(INPUTNUMB_LT), Range(INPUTNUMB_RB)) Then
-                    is_InputRange = INP_NUM
-            Else
-                is_InputRange = INP_NO
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Function check_Adv() As Boolean
-    Dim b As Boolean
-    b = Abs(Range(ADV_SUM_CAP) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_DOC) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_APT) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_CAST) - 1) < 0.0001 _
-        And Abs(Range(ADV_SUM_DIST) - 1) < 0.0001 _
-        Or Range("D13") = 0
-    If Not b Then
-        MsgBox "�� ��������� ��������� ������. �������� ����� ������ ���� = 100%"
-    End If
-    check_Adv = b
-End Function
-
-Function check_budget(r As Range) As Boolean
-    Dim f As Double
-    Dim b As Boolean
-    f = r
-    b = Abs(f - 1#) < 0.0001
-    If Not b Then
-        MsgBox "�� ��������� ��������� ������. �������� ����� ������ ���� = 100%"
-    End If
-    check_budget = b
-End Function
-
-Sub RangeNormalize(Src As Range, Dst As Range)
-    Dim f As Double
-    Dim c As Range
-    f = Dst
-    If f <> 0 Then
-        Src.Worksheet.Unprotect
-        For Each c In Src
-            c = c / f
-        Next c
-        If Not Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") Then
-            Src.Worksheet.Protect
-        End If
-    Else
-        MsgBox "������� ���� �� ���� �����!"
-    End If
-End Sub
-
-Sub GoalSeekNow(Goal As Range, Target As Range)
-    Dim diff As Double
-    
-    diff = Goal - 1
-    If Abs(diff) > 0.0001 Then
-        If (diff > 0 And diff < Target) Or (diff < 0 And 1 - Target > Abs(diff)) Then
-            Goal.GoalSeek Goal:=1, ChangingCell:=Range(Target.Address)
-        Else
-            MsgBox "���������� �������� �� ��������. �������� ������ ��������!"
-        End If
-    End If
-
-End Sub
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100."
-    End If
-End Sub
-
-Sub Check_Number(Target As Range, Def_Val As Double)
-    Dim test As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                test = True
-            End If
-        End If
-    Next r
-    
-    If test Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!"
-    End If
-    
-End Sub
-
-Function is_InputArea(r As Range, LT As Range, RB As Range) As Boolean
-    is_InputArea = r.Column >= LT.Column _
-                And r.Row >= LT.Row _
-                And r.Column <= RB.Column _
-                And r.Row <= RB.Row
-End Function
-
-<<<<<<
-======================
-Sheet70
->>>>>>
-Attribute VB_Name = "Sheet70"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_NUM_1_LT As String = "E14"
-Const INP_NUM_1_RB As String = "J14"
-Const INP_NUM_2_LT As String = "E16"
-Const INP_NUM_2_RB As String = "J16"
-Const INP_NUM_3_LT As String = "E18"
-Const INP_NUM_3_RB As String = "J18"
-Const INP_NUM_4_LT As String = "E20"
-Const INP_NUM_4_RB As String = "J20"
-Const INP_NUM_5_LT As String = "E22"
-Const INP_NUM_5_RB As String = "J22"
-
-Const INP_DAT_1_LT As String = "B14"
-Const INP_DAT_1_RB As String = "C14"
-Const INP_DAT_2_LT As String = "B16"
-Const INP_DAT_2_RB As String = "C16"
-Const INP_DAT_3_LT As String = "B18"
-Const INP_DAT_3_RB As String = "C18"
-Const INP_DAT_4_LT As String = "B20"
-Const INP_DAT_4_RB As String = "C20"
-Const INP_DAT_5_LT As String = "B22"
-Const INP_DAT_5_RB As String = "C22"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("B14").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) <> INP_NO Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Integer
-    Dim test As Boolean
-    
-    test = is_InputArea(r, Range(INP_NUM_1_LT), Range(INP_NUM_1_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_2_LT), Range(INP_NUM_2_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_3_LT), Range(INP_NUM_3_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_4_LT), Range(INP_NUM_4_RB)) _
-        Or is_InputArea(r, Range(INP_NUM_5_LT), Range(INP_NUM_5_RB))
-    If test Then
-       is_InputRange = INP_NUM
-    Else
-        test = is_InputArea(r, Range(INP_DAT_1_LT), Range(INP_DAT_1_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_2_LT), Range(INP_DAT_2_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_3_LT), Range(INP_DAT_3_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_4_LT), Range(INP_DAT_4_RB)) _
-            Or is_InputArea(r, Range(INP_DAT_5_LT), Range(INP_DAT_5_RB))
-        If test Then
-            is_InputRange = INP_DAT
-        Else
-            is_InputRange = INP_NO
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-Sheet30
->>>>>>
-Attribute VB_Name = "Sheet30"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet41
->>>>>>
-Attribute VB_Name = "Sheet41"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const MEMBERSHIP As String = "D7"
-Const MILEAGE As String = "D9"
-Const INPUTAREA_LT As String = "C17"
-Const INPUTAREA_RB As String = "E24"
-
-Const ChangeCheckFlag As Boolean = False
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C17").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-        Case 1
-            Check_Number Target, 1
-        Case 2
-            Check_Number Target, 15
-        Case 3
-            Check_Number Target, 50
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If r.Column = Range(MEMBERSHIP).Column And r.Row = Range(MEMBERSHIP).Row Then
-        is_InputRange = 1
-    Else
-        If r.Column = Range(MILEAGE).Column And r.Row = Range(MILEAGE).Row Then
-            is_InputRange = 2
-        Else
-            If r.Column >= Range(INPUTAREA_LT).Column _
-                And r.Row >= Range(INPUTAREA_LT).Row _
-                And r.Column <= Range(INPUTAREA_RB).Column _
-                And r.Row <= Range(INPUTAREA_RB).Row Then
-                    is_InputRange = 3
-            Else
-                is_InputRange = 0
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet42
->>>>>>
-Attribute VB_Name = "Sheet42"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTDATE_LT As String = "B11"
-Const INPUTDATE_RB As String = "B25"
-Const INPUTTEXT_LT As String = "C11"
-Const INPUTTEXT_RB As String = "C25"
-Const INPUTNUMB_LT As String = "F11"
-Const INPUTNUMB_RB As String = "I25"
-
-Const INP_NO As Integer = 0
-Const INP_DAT As Integer = 1
-Const INP_TXT As Integer = 2
-Const INP_NUM As Integer = 3
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range(INPUTDATE_LT).Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_NUM
-        Check_Number Target, 100
-    Case INP_TXT, INP_DAT
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTDATE_LT), Range(INPUTDATE_RB)) Then
-        is_InputRange = INP_DAT
-    Else
-        If is_InputArea(r, Range(INPUTTEXT_LT), Range(INPUTTEXT_RB)) Then
-            is_InputRange = INP_TXT
-        Else
-            If is_InputArea(r, Range(INPUTNUMB_LT), Range(INPUTNUMB_RB)) Then
-                    is_InputRange = INP_NUM
-            Else
-                is_InputRange = INP_NO
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet60
->>>>>>
-Attribute VB_Name = "Sheet60"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC_LT As String = "C10"
-Const INP_DOC_RB As String = "C16"
-Const INP_APT_LT As String = "E10"
-Const INP_APT_RB As String = "E16"
-Const INP_CAST_LT As String = "G10"
-Const INP_CAST_RB As String = "G16"
-Const INP_DIST_LT As String = "I10"
-Const INP_DIST_RB As String = "I16"
-Const CAP_DOC As String = "C9"
-Const CAP_APT As String = "E9"
-Const CAP_CAST As String = "G9"
-Const CAP_DIST As String = "I9"
-
-
-Const INP_NO As Integer = 0
-Const INP_CAP As Integer = 1
-Const INP_DOC As Integer = 2
-Const INP_APT As Integer = 3
-Const INP_CAST As Integer = 4
-Const INP_DIST As Integer = 5
-
-Const INP_SUM_CAP As Integer = 11
-Const INP_SUM_DOC As Integer = 12
-Const INP_SUM_APT As Integer = 13
-Const INP_SUM_CAST As Integer = 14
-Const INP_SUM_DIST As Integer = 15
-
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim Inp As Integer
-    Dim Addr As String
-    Inp = is_InputRange(Target)
-    Select Case is_InputRange(Target)
-        Case INP_NO
-            Cancel = False
-        
-        Case INP_CAP
-            GoalSeekNow Range(ADV_SUM_CAP), Target
-        
-        Case INP_DOC
-            GoalSeekNow Range(ADV_SUM_DOC), Target
-        
-        Case INP_APT
-            GoalSeekNow Range(ADV_SUM_APT), Target
-        
-        Case INP_CAST
-            GoalSeekNow Range(ADV_SUM_CAST), Target
-        
-        Case INP_DIST
-            GoalSeekNow Range(ADV_SUM_DIST), Target
-        
-        Case INP_SUM_CAP
-            Addr = CAP_DOC & "," & CAP_APT & "," & CAP_CAST & "," & CAP_DIST
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_DOC
-            Addr = INP_DOC_LT & ":" & INP_DOC_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_APT
-            Addr = INP_APT_LT & ":" & INP_APT_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_CAST
-            Addr = INP_CAST_LT & ":" & INP_CAST_RB
-            RangeNormalize Range(Addr), Target
-        
-        Case INP_SUM_DIST
-            Addr = INP_DIST_LT & ":" & INP_DIST_RB
-            RangeNormalize Range(Addr), Target
-    End Select
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Select Case is_InputRange(Target)
-    Case INP_CAP
-        Check_Percent Target, 0.25
-    Case INP_DOC, INP_APT, INP_CAST, INP_DIST
-        Check_Percent Target, 0.15
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) > 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Integer
-    is_InputRange = INP_NO
-    If r.Row = Range(CAP_DOC).Row Then
-        If r.Column = Range(CAP_DOC).Column _
-                Or r.Column = Range(CAP_APT).Column _
-                Or r.Column = Range(CAP_CAST).Column _
-                Or r.Column = Range(CAP_DIST).Column Then
-            is_InputRange = INP_CAP
-        End If
-        If r.Column = Range(ADV_SUM_CAP).Column Then
-            is_InputRange = INP_SUM_CAP
-        End If
-    Else
-        If is_InputArea(r, Range(INP_DOC_LT), Range(INP_DOC_RB)) Then
-            is_InputRange = INP_DOC
-        Else
-            If is_InputArea(r, Range(INP_APT_LT), Range(INP_APT_RB)) Then
-                is_InputRange = INP_APT
-            Else
-                If is_InputArea(r, Range(INP_CAST_LT), Range(INP_CAST_RB)) Then
-                    is_InputRange = INP_CAST
-                Else
-                    If is_InputArea(r, Range(INP_DIST_LT), Range(INP_DIST_RB)) Then
-                        is_InputRange = INP_DIST
-                    Else
-                        If r.Row = Range(ADV_SUM_DOC).Row Then
-                            If r.Column = Range(ADV_SUM_DOC).Column Then
-                                is_InputRange = INP_SUM_DOC
-                            End If
-                            If r.Column = Range(ADV_SUM_APT).Column Then
-                                is_InputRange = INP_SUM_APT
-                            End If
-                            If r.Column = Range(ADV_SUM_APT).Column Then
-                                is_InputRange = INP_SUM_APT
-                            End If
-                            If r.Column = Range(ADV_SUM_CAST).Column Then
-                                is_InputRange = INP_SUM_CAST
-                            End If
-                            If r.Column = Range(ADV_SUM_DIST).Column Then
-                                is_InputRange = INP_SUM_DIST
-                            End If
-                        End If
-                    End If
-                End If
-            End If
-        End If
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet50
->>>>>>
-Attribute VB_Name = "Sheet50"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.7
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range("C9").Column _
-                    And r.Row = Range("C9").Row
-End Function
-
-
-<<<<<<
-======================
-Sheet51
->>>>>>
-Attribute VB_Name = "Sheet51"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INPUTAREA_LT As String = "C17"
-Const INPUTAREA_RB As String = "E20"
-
-Const ChangeCheckFlag As Boolean = False
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C17").Select
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) <> 0 Then
-        Check_Number Target, 50
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE") = True
-    If is_InputRange(Target) <> 0 Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Integer
-    If is_InputArea(r, Range(INPUTAREA_LT), Range(INPUTAREA_RB)) Then
-        is_InputRange = 3
-    Else
-        is_InputRange = 0
-    End If
-End Function
-
-
-<<<<<<
-======================
-Sheet80
->>>>>>
-Attribute VB_Name = "Sheet80"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const INP_DOC As String = "C9"
-Const INP_APT As String = "C11"
-Const INP_CUST As String = "C13"
-Const INP_DIST As String = "C15"
-Const INP_SUM As String = "C17"
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Range("C9").Select
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    
-    If is_InputRange(Target) Then
-        GoalSeekNow Range(INP_SUM), Target
-    Else
-        If Target.Row = Range(INP_SUM).Row And Target.Column = Range(INP_SUM).Column Then
-            Dim Addr As String
-            
-            Addr = INP_DOC & "," & INP_APT & "," & INP_CUST & "," & INP_DIST
-            RangeNormalize Range(Addr), Target
-            
-        End If
-    End If
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If is_InputRange(Target) Then
-        Check_Percent Target, 0.25
-    End If
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim DebugMode As Boolean
-    DebugMode = Worksheets(DATA_SHEET).Range("BOOL_DESIGN_MODE")
-    
-    If is_InputRange(Target) Or DebugMode Then
-        Unprotect
-    Else
-        Protect
-    End If
-End Sub
-
-Function is_InputRange(r As Range) As Boolean
-    is_InputRange = r.Column = Range(INP_DOC).Column _
-                And ( _
-                    r.Row = Range(INP_DOC).Row _
-                    Or r.Row = Range(INP_APT).Row _
-                    Or r.Row = Range(INP_CUST).Row _
-                    Or r.Row = Range(INP_DIST).Row _
-                )
-End Function
-
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Print"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 4
-                        .OnAction = "cmPrint"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-'                With .Controls
-'                    With .Add(msoControlButton)
-'                        .Caption = "&Contents"
-'                        .Style = msoButtonIconAndCaption
-'                        .FaceId = 49
-'                        .OnAction = "cmHelpContents"
-'                    End With
-'                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(Flag As Boolean)
-    If Flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars("Worksheet Menu Bar")
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    dlgAbout.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlgAbout.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlgAbout.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlgAbout.Show
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-        helppath = "hh.exe " & .Path & "\Telfast.chm"
-        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub cmSetStandaloneMode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-    ThisWorkbook.Worksheets("home").Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    rp = common_pwd
-    dlgGetPwd.edPwd = ""
-    dlgGetPwd.Show
-    If dlgGetPwd.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-    Else
-        cmSetStandaloneMode
-    End If
-    ThisWorkbook.Worksheets("home").Select
-End Sub
-
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If Application.Workbooks.Count > 1 Then
-        wbname = Wb.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKCancel, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            Wb.Close Savechanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars("Worksheet Menu Bar").Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars("Worksheet Menu Bar").Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        cmHelpContents
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Telfast bar"
-Public Const common_pwd As Long = 31415926
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(HOME_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                     cWindow.DisplayHeadings = True
-                Next
-            End If
-        Next
-        .Worksheets(HOME_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu (True)
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{6B54EA33-E5D1-44C0-BC3C-E5960329B246}{639FA6FC-FBAC-44B4-ACC5-7DAF95DA47F4}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    
-    dlgPrint.cbMainReport = True
-    dlgPrint.cbMainBudget = False
-    dlgPrint.cbSrcData = False
-    dlgPrint.cbAllSheets = False
-    
-    dlgPrint.Show
-    
-    If dlgPrint.Tag = vbCancel Then
-        Exit Sub
-    End If
-    
-    Dim PrnIdx As Integer
-    
-    With dlgPrint
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("home", "budget", "Final")
-    Case 1111
-        plist = Array("home", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("home")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-dlgFname
->>>>>>
-Attribute VB_Name = "dlgFname"
-Attribute VB_Base = "0{AB4D9ABD-F40E-4C39-8FE4-0625E69E5365}{2CC3E532-33AC-44D8-9195-34917AF21E8C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btOK_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Macro1()
-Attribute Macro1.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro1.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro1 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    Charts.Add
-    ActiveChart.ChartType = xlBubble
-    ActiveChart.SetSourceData Source:=Sheets("file1").Range("H2:J11"), PlotBy:= _
-        xlColumns
-    ActiveChart.Location Where:=xlLocationAsObject, Name:="file1"
-    With ActiveChart
-        .HasTitle = True
-        .ChartTitle.Characters.Text = "�������"
-        .Axes(xlCategory, xlPrimary).HasTitle = True
-        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "���� ��������"
-        .Axes(xlValue, xlPrimary).HasTitle = True
-        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "���������� �������"
-    End With
-    With ActiveChart.Axes(xlCategory)
-        .HasMajorGridlines = True
-        .HasMinorGridlines = False
-    End With
-    With ActiveChart.Axes(xlValue)
-        .HasMajorGridlines = True
-        .HasMinorGridlines = False
-    End With
-    ActiveChart.HasLegend = False
-    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
-    ActiveChart.SeriesCollection(1).Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(9).DataLabel.Select
-    Selection.Characters.Text = "8379 �1"
-    Selection.AutoScaleFont = False
-    With Selection.Characters(Start:=1, Length:=7).Font
-        .Name = "Arial"
-        .FontStyle = "�������"
-        .Size = 10
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveChart.Axes(xlValue).MajorGridlines.Select
-End Sub
-Sub Macro2()
-Attribute Macro2.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro2.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro2 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    Application.CutCopyMode = False
-    With ActiveChart.ChartGroups(1)
-        .VaryByCategories = True
-        .ShowNegativeBubbles = False
-        .SizeRepresents = xlSizeIsArea
-        .BubbleScale = 100
-    End With
-End Sub
-Sub Macro3()
-Attribute Macro3.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute Macro3.VB_ProcData.VB_Invoke_Func = " \n14"
-'
-' Macro3 Macro
-' Macro recorded 25.09.2003 by nick
-'
-
-'
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(6).DataLabel.Select
-    ActiveChart.Axes(xlValue).MajorGridlines.Select
-    ActiveChart.SeriesCollection(1).DataLabels.Select
-    ActiveChart.SeriesCollection(1).Points(6).DataLabel.Select
-    Selection.Characters.Text = "9847 �2"
-    Selection.AutoScaleFont = False
-    With Selection.Characters(Start:=1, Length:=7).Font
-        .Name = "Arial"
-        .FontStyle = "�������"
-        .Size = 12
-        .Strikethrough = False
-        .Superscript = False
-        .Subscript = False
-        .OutlineFont = False
-        .Shadow = False
-        .Underline = xlUnderlineStyleNone
-        .ColorIndex = xlAutomatic
-    End With
-    ActiveChart.PlotArea.Select
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_Open()
-    xlRestoreView
-End Sub
-
-Sub xlRestoreView()
-    Application.CommandBars("Standard").Visible = True
-    Application.CommandBars("Formatting").Visible = True
-    Application.DisplayFormulaBar = True
-End Sub
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'ClexanePM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    Application.ScreenUpdating = True
-'    CheckUser
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).update_history
-    Application.Calculate
-
-End Sub
-
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "QTR_SEL"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Worksheets(REP_QTR_SHEET).Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .setEnt_date (ent_date)
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).getEnt_date()
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public ppReport As New cPPReport
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[PM]"
-Public Const PROGRAM_VERSION As String = "Clexane[PM] ver 1.1"
-Public Const PROGRAM_FILENAME As String = "clexane-pm"
-Public Const PROGRAM_BACKUPNAME As String = "pm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "pm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "rm-ex*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-Public Const CHART_DEF_TITLE As String = "* * *"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20031207
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O41"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-Public Const PRJ_QTR_SHEET As String = "PRJ_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Function time_correct(end_date As Long, ByVal theDate As Date) As Boolean
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-    If end_date = NO_ESTIMATION_DATE Then
-        time_correct = True
-        Exit Function
-    End If
-    
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    
-    time_correct = CurDate <= end_date
-    
-End Function
-
-Sub EnableRun(end_date As Long)
-    If Not time_correct(end_date, Now) Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub t()
-    EnableRun ESTIMATION_DATE
-End Sub
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Sub OpenPPT()
-    ppReport.ReportView
-End Sub
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    SelectLPU_BDGT lpu_id, ent_date
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .setEnt_date (ent_date)
-            .Range("lpu_id") = lpu_id
-            .Range("REP_ID") = rep_id
-            .Range("RM_ID") = rm_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("RM_ID") = rm_id
-        .Range("REP_ID") = rep_id
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.Name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{32FB0F3D-6884-41DC-99DB-E2C55B2257C4}{DED79A66-DA60-4CCC-9003-082480235D55}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{0DC9E035-CE0A-49FF-85A2-A4EC5FF8FE96}{D54DDC8A-1EE2-4BB3-8B94-343B521AF098}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S15"
-
-Sub PrintCopy()
-    Range("B1:K21").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), Range("RM_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    objLPU = Get_LPU_Record(id, Range("RM_ID"))
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.Name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BFB4547C-96A7-4739-AA0A-CEF1E35E2BDC}{C3D618A3-9410-4BC7-9D93-3B049D361132}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.Name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-    sh.Range("ret_addr") = ""
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{9AAD262F-A6C4-4912-9C58-D7A2071181B8}{9470F4EB-DA9F-4584-9159-D09319548D21}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{A8FBEE9C-DE59-49DE-971D-07BC9C0E9BD2}{C712732B-D8E4-4C2D-8E78-AC90968E0CD7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hw_reset()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        MsgBox "2"
-        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-'    Dim cREGMAN As tREGMAN
-'    Dim idx As Integer
-'    Dim dlg_ui As UserInfo
-'
-'    Set dlg_ui = New UserInfo
-'
-'    cREGMAN = Get_REGMAN_Record()
-'
-'    With ThisWorkbook.Worksheets(REGS_SHEET)
-'        .Range("IDX_REGION") = cREGMAN.Region
-'        .Range("IDX_CITY") = cREGMAN.City
-'    End With
-'
-'    With dlg_ui
-'        .cbRegion = cREGMAN.Region
-'        .cbCity = cREGMAN.City
-'        .tbFName = cREGMAN.FirstName
-'        .tbLName = cREGMAN.LastName
-'    End With
-'
-'    dlg_ui.Show
-'    Worksheets(REGS_SHEET).Calculate
-'
-'    If dlg_ui.Tag = vbOK Then
-'        With cREGMAN
-'            .Region = dlg_ui.cbRegion.Value
-'            .City = dlg_ui.cbCity.Value
-'            .FirstName = dlg_ui.tbFName.Value
-'            .LastName = dlg_ui.tbLName.Value
-'        End With
-'        Set_REGMAN_Record cREGMAN
-'    Else
-'        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-'    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    rm_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String, rm_id As Long) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String, rm_id As Long) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .rm_id = rm_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    rm_id As Long
-    Name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long, rm_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long, rm_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.Name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.Name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.rm_id = dbRecordset("rm_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id " & _
-    "AND lpu.rep_id=" & rep_id & " AND lpu.rm_id=lpu_budget.rm_id AND lpu.rm_id=" & rm_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds, lpu.rm_id AS rm_id " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .Name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cdbRM
->>>>>>
-Attribute VB_Name = "cdbRM"
-Option Explicit
-
-Public Type tRMID_COMMON
-    rm As tREGMAN
-    rgcd_count As Integer
-    rgcd() As tREGION
-End Type
-
-Function Get_RM_CommonList_by_QTR(ByRef rmcd() As tRMID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_RM_CommonList_by_QTR = dbGet_RM_CommonList_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_RM_CommonList_by_QTR(dbConnection As Object, ByRef rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    ' �������� ������ RM-��
-    Dim count As Integer
-    count = db_get_All_RM_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    Dim i As Integer
-    For i = 1 To count
-        rmcd(i).rgcd_count = 1
-        ReDim rmcd(i).rgcd(1 To 1)
-        getREGION_by_QTR ent_date, rmcd(i).rgcd(1), rmcd(i).rm.rm_id
-    Next i
-    dbGet_RM_CommonList_by_QTR = count
-End Function
-
-Function db_get_All_RM_by_QTR(dbConnection As Object, rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    
-    Dim count_sql As String
-    Dim get_sql As String
-    Dim rs As Object
-    Dim RM_Count As Integer
-        
-    count_sql = "SELECT COUNT(*) AS RM_TOTAL FROM reg_man"
-    get_sql = "SELECT * FROM reg_man"
-    Set rs = CreateObject("ADODB.Recordset")
-    rs.Open count_sql, dbConnection
-    
-    If Not rs.BOF Then
-        RM_Count = rs("RM_TOTAL")
-    End If
-    
-    rs.Close
-    
-     db_get_All_RM_by_QTR = RM_Count
-    
-    If RM_Count > 0 Then
-        'we have records
-        ReDim rmcd(1 To RM_Count)
-        Dim index As Long
-        index = 1
-        rs.Open get_sql, dbConnection
-        
-        If Not rs.BOF Then
-             Do While Not rs.EOF
-                 Dim tmp_rmcd As tRMID_COMMON
-                 With tmp_rmcd
-                    .rgcd_count = 0
-                    .rm.City = rs("city")
-                    .rm.FirstName = rs("firstname")
-                    .rm.LastName = rs("lastname")
-                    .rm.rm_id = rs("mgr_id")
-                    .rm.Region = rs("region")
-                 End With
-                 
-                 rmcd(index) = tmp_rmcd
-                 index = index + 1
-                 rs.MoveNext
-             Loop
-        End If
-    End If
-    
-End Function
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-           With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub CreateExtCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom extendet commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Add New Slide"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 280
-                .OnAction = "cmAddSlide"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        Application.ScreenUpdating = False
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        Application.ScreenUpdating = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmNewReport()
-    ppReport.CreateReport
-    MsgBox "����� ����� ������", vbInformation + vbOKOnly, PROGRAM_NAME
-    CreateExtCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmOpenReport()
-    Dim fileToOpen
-    Dim s As String
-    fileToOpen = Application _
-        .GetOpenFileName("Report Files (*.ppt), *.ppt", title:="Report OPen", MultiSelect:=False)
-    If fileToOpen <> False Then
-        s = fileToOpen
-        ppReport.OpenReport s
-        CreateExtCommandBar theApp:=ThisWorkbook.Application
-    End If
-End Sub
-
-Sub cmCloseReport()
-    On Error Resume Next
-    ppReport.SaveReport
-    CreateCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmAddSlide()
-    ThisWorkbook.ActiveSheet.PrintCopy
-    ppReport.InsertSlide
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("PRJ_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Unprotect
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("LPU_LIST")
-        s = .Range("C4") & " " & .Range("C3") & ", " & .Range("G4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-End Sub
-
-Sub btLPU_DEL_IT()
-'    Dim cLPU As tLPU
-'    Dim ent_date As String
-'    Dim delete_all As Integer
-'    Dim dlg_del As dlg_LPU_delete
-'
-'    With Worksheets("LPU_LIST")
-'        ent_date = .Range("ent_date")
-'        cLPU.id = .getCurrentLPU_ID()
-'    End With
-'
-'    If cLPU.id = 0 Then
-'        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-'        Exit Sub
-'    End If
-'    cLPU = Get_LPU_Record(cLPU.id)
-'
-'    Set dlg_del = New dlg_LPU_delete
-'    With dlg_del
-'        .chbDeleteQTR.Value = True
-'        .chbDeleteAll.Value = False
-'        .lComment = ent_date & ": �������� ��� '" _
-'        & cLPU.Name & "', �������������� �� ������:" _
-'        & cLPU.address & " �� ���������."
-'        .Show
-'    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    rm_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-        .rm_id = rm_id
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.rm_id = dbRecordset("rm_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id, rm_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    Dim rep_sql As String
-    Dim rm_sql As String
-    
-    rep_sql = ""
-    rm_sql = ""
-    
-    If rep_id <> 0 Then
-        rep_sql = " AND rep_id=" & rep_id
-    End If
-    
-    If rm_id <> 0 Then
-        rm_sql = " AND rm_id=" & rm_id
-    End If
-    
-    
-        getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql
-        getAll_QTR_SQL = "SELECT * FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql & " ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{92648543-CB84-4B6B-BEB3-539AE7EF9D84}{7E20E3E3-027A-483B-A14D-AA9EA5398ACC}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "��������� �����: " & Range("title")
-    Range("view_key") = False
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(%): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{067FED69-B41E-427D-AF59-5798B8E2E73A}{4C13CAB1-FDCC-4708-89EB-E92EDC125712}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id, objQTR.rm_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "���� ������: " & Range("title")
-    
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� ������: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "������� ���: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{9C81F4D2-4ECF-46F5-999B-9801D572A12F}{B382508B-7F3D-4747-8407-0F75F6F265F5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{EA8CE4CE-AC2E-45BC-BAF8-1429E6242097}{575F0762-04F4-4F86-B98A-8E87E3424B0D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(rep_id As Long, rm_id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, rep_id As Long, rm_id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT * FROM " & _
-          "rep WHERE rep_id=" & rep_id & " AND rm_id=" & rm_id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.rm_id = dbRecordset("rm_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    If rm_id <> 0 Then
-        Where = Where & " AND rep.rm_id=" & rm_id
-    End If
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record(Range("RM_ID"))
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN, Range("RM_ID"))
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record(rm_id As Long) As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSet_REGMAN_Record dbConnection, cREGMAN
-'    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object, rm_id As Long) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    objREGMAN.rm_id = rm_id
-    sql = "SELECT * FROM " & _
-          "reg_man WHERE mgr_id=" & rm_id
-          
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM reg_man"
-'    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREGMAN.FirstName & "', " & _
-'    "'" & objREGMAN.LastName & "', " & _
-'    objREGMAN.Region & ", " & _
-'    objREGMAN.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    Name As String
-End Type
-
-Public Type tDBTABLE
-    Name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).Name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).Name = "entry_date"
-    tables(1).field(2).Name = "bdgt_NMG"
-    tables(1).field(3).Name = "bdgt_NFG"
-    tables(1).field(4).Name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).Name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).Name = "entry_date"
-    tables(2).field(2).Name = "operations_per_quarter"
-    tables(2).field(3).Name = "risk_percent"
-    tables(2).field(4).Name = "patients_with_risk_ON"
-    tables(2).field(5).Name = "patients_ambulator"
-    tables(2).field(6).Name = "patients_ambulator_nmg"
-    tables(2).field(7).Name = "patients_ambulator_clexan"
-    tables(2).field(8).Name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).Name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).Name = "patients_stationar_nmg"
-    tables(2).field(11).Name = "patients_stationar_clexan"
-    tables(2).field(12).Name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).Name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).Name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).Name = "entry_date"
-    tables(3).field(2).Name = "patients_with_geparins"
-    tables(3).field(3).Name = "patients_per_quarter"
-    tables(3).field(4).Name = "patients_stationar_nmg"
-    tables(3).field(5).Name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).Name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).Name = "entry_date"
-    tables(4).field(2).Name = "patients_with_geparins"
-    tables(4).field(3).Name = "patients_per_quarter"
-    tables(4).field(4).Name = "patients_stationar_nmg"
-    tables(4).field(5).Name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).Name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).Name = "entry_date"
-    tables(5).field(2).Name = "patients_per_quarter"
-    tables(5).field(3).Name = "risk_percent"
-    tables(5).field(4).Name = "patients_with_risk_ON"
-    tables(5).field(5).Name = "patients_ambulator"
-    tables(5).field(6).Name = "patients_ambulator_nmg"
-    tables(5).field(7).Name = "patients_ambulator_clexan"
-    tables(5).field(8).Name = "patients_stationar_nmg"
-    tables(5).field(9).Name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).Name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).Name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).Name) = getRS(tables(tbl_idx).field(fld_idx).Name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 10)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    tables_to_clear(9) = "quarter_rm"
-    tables_to_clear(10) = "reg_man"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-cdbPRJ
->>>>>>
-Attribute VB_Name = "cdbPRJ"
-Option Explicit
-
-Type tPROJECT
-    total_SALE  As Long ' ����� ����� ������
-    total_BDGT  As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU   As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_RM    As Long ' ����� �����
-    total_BEDS  As Long ' ����� ����� ����
-    total_HIR   As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER   As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS   As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN   As Long '  ���� ������ ��������
-    objRGN() As tREGION
-End Type
-
-Function GetPRJ_COMM_DATA(ByRef prj_data As tPROJECT) As Integer
-    Dim i As Integer
-    i = GetRGN_COMM_DATA(prj_data.objRGN, 0)
-    GetPRJ_COMM_DATA = i
-    If i > 0 Then
-        With prj_data
-            .sale_PLAN = 0
-            .total_ACS = 0
-            .total_BDGT = 0
-            .total_BDGT_NMG = 0
-            .total_BEDS = 0
-            .total_HIR = 0
-            .total_LPU = 0
-            .total_REP = 0
-            .total_RM = 0
-            .total_SALE = 0
-            .total_TER = 0
-            For i = 1 To UBound(prj_data.objRGN)
-                
-            Next i
-        End With
-    End If
-
-End Function
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-        .setEnt_date (getEnt_date())
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("RM_ID") = rm_id
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    Dim rm_struc As tREGMAN
-    
-    i = Range("RM_ID")
-    rm_struc = Get_REGMAN_Record(i)
-    
-    Range("C4") = rm_struc.LastName
-    Range("C5") = rm_struc.FirstName
-
-    Range("G5") = GetRegionName(rm_struc.Region)
-    
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date, Range("RM_ID"))
-
-    
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_LIST")
-        s = .Range("C5") & " " & .Range("C4") & ", " & .Range("G5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("REP_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date, rm_id)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id, allREPID(i).rm_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    rm_id As Long
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION, rm_id As Long) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date, rm_id)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_REP_count As Integer
-            reg_data(i).rm_id = rm_id
-            reg_data(i).ent_date = q_date(i)
-            current_REP_count = getREGION_by_QTR(q_date(i), reg_data(i), rm_id)
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-' if rm_id = 0 then gets all records
-Function getAllQTRNames(ByRef qtr_lst() As String, rm_id As Long) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    
-    If rm_id <> 0 Then
-        sql = sql & " WHERE rm_id=" & rm_id
-    End If
-    
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION, rm_id As Long) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tQTR_COMMON
-    rep_count = Get_QTR_CommonList_by_REP(reps, ent_date, 0, rm_id)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .c_bdgt_NFG + .c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtr.sale_PLAN
-                treg.total_SALE = treg.total_SALE + .c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .c_pat_HIR
-                treg.total_TER = treg.total_TER + .c_pat_TER
-                treg.total_ACS = treg.total_ACS + .c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .i_lcd
-                treg.total_BEDS = treg.total_BEDS + .c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-'            def_dir = GetWBPath(ThisWorkbook.FullName)
-'            If GetImportDirectory(def_dir, flist) Then
-'                Dim db_list() As String
-'                i = GetDBList(flist, db_list)
-'                If i > 0 Then
-'                    ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-'                End If
-'            End If
-'            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Range("ret_addr") = "RM_QTR"
-            Worksheets("REP_LIST").setEnt_date (Worksheets(RM_QTR_SHEET).getEnt_date())
-            Worksheets("REP_LIST").Range("RM_ID") = Worksheets(RM_QTR_SHEET).Range("RM_ID")
-            Worksheets("REP_LIST").Range("VIEW_ONLY") = True
-
-            Worksheets("REP_LIST").Select
-        Case 3
-            MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub btRM_QTR_RET_IT()
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cPPReport
->>>>>>
-Attribute VB_Name = "cPPReport"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Const PPR_NON As Integer = 0
-Const PPR_NEW As Integer = 1
-Const PPR_OLD As Integer = 2
-
-Dim ReportApp As PowerPoint.Application
-Dim ReportDoc As PowerPoint.Presentation
-Dim ReportState As Integer
-Dim PowerPointPath As String
-
-Private Sub Class_Initialize()
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    PowerPointPath = ReportApp.Path & "\PowerPNT.EXE"
-    ReportState = PPR_NON
-End Sub
-
-Sub OpenReport(FileName As String)
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = GetObject(FileName)
-    ReportState = PPR_OLD
-End Sub
-
-Sub CreateReport()
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = ReportApp.Presentations.Add
-    ReportState = PPR_NEW
-End Sub
-
-Sub SaveReport()
-    Select Case ReportState
-        Case PPR_NEW
-            ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME
-        Case PPR_OLD
-            ReportDoc.Save
-    End Select
-    ReportState = PPR_NON
-End Sub
-
-Sub ReportView()
-    Dim CmdName As String
-    CmdName = GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME + ".PPT"
-    CmdName = PowerPointPath & " " & CmdName
-    Shell CmdName, 1
-End Sub
-
-Sub InsertSlide()
-    Dim ReportPage As PowerPoint.Slide
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.count + 1, ppLayoutBlank)
-    
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = "Slide #" & Format(ReportDoc.Slides.count)
-End Sub
-
-
-Private Sub Class_Terminate()
-    SaveReport
-    ReportApp.Quit
-End Sub
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{36355920-F7A4-44A8-96EF-5D79CF26137D}{F852BDF2-AB3E-468E-89DF-EC5DC0C7C88B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-rmImport
->>>>>>
-Attribute VB_Name = "rmImport"
-Option Explicit
-
-Public Type dbDESCRIPTION
-    Name As String
-    Fields() As String
-End Type
-
-Sub ImportFromRegionalManagers(rm_files() As String, fm_file As String)
-    Dim db(9) As dbDESCRIPTION
-    
-    '''''data
-    db(1).Name = "rep"
-    
-    db(2).Name = "lpu"
-    db(3).Name = "lpu_acs"
-    db(4).Name = "lpu_budget"
-    db(5).Name = "lpu_hir"
-    db(6).Name = "lpu_im"
-    db(7).Name = "lpu_ter"
-    db(8).Name = "quarter"
-    db(9).Name = "quarter_rm"
-    
-    ReDim db(1).Fields(5)
-    With db(1)
-        .Fields(1) = "rep_id"
-        .Fields(2) = "firstname"
-        .Fields(3) = "lastname"
-        .Fields(4) = "region"
-        .Fields(5) = "city"
-    End With
-    
-    ReDim db(2).Fields(5)
-    With db(2)
-        .Fields(1) = "id"
-        .Fields(2) = "rep_id"
-        .Fields(3) = "name"
-        .Fields(4) = "address"
-        .Fields(5) = "beds"
-    End With
-    
-    ReDim db(3).Fields(7)
-    With db(3)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(4).Fields(6)
-    With db(4)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "bdgt_NMG"
-        .Fields(5) = "bdgt_NFG"
-        .Fields(6) = "sale_PLAN"
-    End With
-    
-    ReDim db(5).Fields(15)
-    With db(5)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "operations_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_ambulator_clexan_40mg"
-        .Fields(11) = "patients_ambulator_clexan_20mg"
-        .Fields(12) = "patients_stationar_nmg"
-        .Fields(13) = "patients_stationar_clexan"
-        .Fields(14) = "patients_stationar_clexan_40mg"
-        .Fields(15) = "patients_stationar_clexan_20mg"
-    End With
-    
-    
-    ReDim db(6).Fields(7)
-    With db(6)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(7).Fields(11)
-    With db(7)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_stationar_nmg"
-        .Fields(11) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(8).Fields(9)
-    With db(8)
-        .Fields(1) = "ID"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "rep_id"
-        .Fields(4) = "sale_plan"
-        .Fields(5) = "ClxnH20mg"
-        .Fields(6) = "ClxnH40mg"
-        .Fields(7) = "ClxnT40mg"
-        .Fields(8) = "ClxnC_IM"
-        .Fields(9) = "ClxnC_ACS"
-    End With
-    
-    ReDim db(9).Fields(3)
-    With db(9)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "sale_plan"
-    End With
-    
-    Dim rm_idx As Integer
-    Dim to_db As Object
-    'back uo
-    Merge_BackUp_All_Data
-    
-    'clean up
-    Merge_Clear_All_Data fm_file
-    
-    Set to_db = dbGetConnection(fm_file)
-    
-    For rm_idx = 1 To UBound(rm_files)
-        Dim from_db As Object
-        
-        Set from_db = dbGetConnection(rm_files(rm_idx))
-        
-        Dim new_rm_id As Long
-        new_rm_id = dbMergeRM(from_db, to_db)
-
-        Dim i As Integer
-
-        For i = 1 To UBound(db)
-            Dim get_sql As String
-            Dim getRS As Object
-            Dim insRS As Object
-            Dim field_idx As Integer
-                        
-            get_sql = "SELECT * FROM " & db(i).Name
-            Set getRS = CreateObject("ADODB.Recordset")
-            Set insRS = CreateObject("ADODB.Recordset")
-            insRS.Open db(i).Name, to_db, 2, 2
-
-            getRS.Open get_sql, from_db
-            
-            If Not getRS.BOF Then
-                Do While Not getRS.EOF
-                    insRS.addnew
-                    Dim fld_name As String
-                    
-                    For field_idx = 1 To UBound(db(i).Fields)
-                        fld_name = db(i).Fields(field_idx)
-                        insRS(fld_name) = getRS(fld_name)
-                    Next field_idx
-                    
-                    insRS("rm_id") = new_rm_id
-                    insRS.Update
-                    getRS.MoveNext
-                Loop
-            
-            Else
-                'empty table
-                ' do nothing
-            End If
-            
-            
-        Next i
-        
-        dbCloseOpenedConnection from_db
-    Next rm_idx
-    
-    dbCloseOpenedConnection to_db
-End Sub
-
-Function dbMergeRM(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM reg_man"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about Regional Manager! This database cannot be merged!!!"
-            dbMergeRM = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "reg_man", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    dbMergeRM = insertRecordset("mgr_id")
-    
-End Function
-
-Sub cmDataImport()
-    Dim def_dir As String
-    Dim flist() As String
-    Dim i As Integer
-
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        
-        If i > 0 Then
-            ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-        End If
-    End If
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-
-<<<<<<
-======================
-PRJ_QTR
->>>>>>
-Attribute VB_Name = "PRJ_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CPRJ_QT As Integer = 0
-Const CPRJ_ID As Integer = 1
-Const CPRJ_PLN As Integer = 2
-Const CPRJ_FCT As Integer = 3
-Const CPRJ_BDG As Integer = 4
-Const CPRJ_CNT As Integer = 5
-Const CPRJ_BEDS As Integer = 6
-Const CPRJ_HIR As Integer = 7
-Const CPRJ_TER As Integer = 8
-Const CPRJ_CRD As Integer = 9
-Const CPRJ_CLXN_BDG As Integer = 10
-Const CPRJ_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("PRJ_QTR")
-        s = "��� �������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tREGION
-    Dim i As Long
-    Dim r As Range
-
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objQTR(), 0)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CPRJ_QT) = objQTR(i).ent_date
-            r.Offset(i - 1, CPRJ_ID) = ""
-            r.Offset(i - 1, CPRJ_PLN) = objQTR(i).sale_PLAN
-            r.Offset(i - 1, CPRJ_FCT) = objQTR(i).total_SALE
-            r.Offset(i - 1, CPRJ_BDG) = objQTR(i).total_BDGT
-            r.Offset(i - 1, CPRJ_CNT) = objQTR(i).total_LPU
-            r.Offset(i - 1, CPRJ_BEDS) = objQTR(i).total_REP
-            r.Offset(i - 1, CPRJ_HIR) = objQTR(i).total_HIR
-            r.Offset(i - 1, CPRJ_TER) = objQTR(i).total_TER
-            r.Offset(i - 1, CPRJ_CRD) = objQTR(i).total_ACS
-            If objQTR(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_BDG) = objQTR(i).total_SALE / objQTR(i).total_BDGT
-            End If
-            If objQTR(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_NMG) = objQTR(i).total_SALE / objQTR(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CPRJ_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_CLXN_NMG + 1)
-        End If
-    Next i
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Public Sub cbxPRJ_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_PRJ
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_PRJ
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_PRJ
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = PRJ_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CPRJ_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "PRJ_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btPRJ_QTR_Do_IT ' old btRM_OTR_DO_IT
-End Sub
-
-<<<<<<
-======================
-RM_LIST
->>>>>>
-Attribute VB_Name = "RM_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentRM_ID() As Long
-    Dim r As Range
-
-    With Worksheets("RM_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CRM_ID)
-    End With
-
-    getCurrentRM_ID = r
-End Function
-
-Public Sub RM_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("PM_CHR_IDX")
-        Case 1
-            Rm_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rm_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rm_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-
-        Case 4
-            Rm_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectRM_QTR(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "RM_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("RM_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Public Sub SelectREP_LIST(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "REP_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .setEnt_date (getEnt_date())
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateRMList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Sub UpdateRMList()
-    Dim rmcd() As tRMID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_RM_CommonList_by_QTR(rmcd(), ent_date)
-
-    With ThisWorkbook.Worksheets("RM_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rmcd)
-            r.Offset(i - 1, CRM_NAME) = GetRegionName(rmcd(i).rm.Region)
-            r.Offset(i - 1, CRM_ID) = rmcd(i).rm.rm_id
-            r.Offset(i - 1, CRM_BEDS) = rmcd(i).rgcd(1).total_BEDS
-            r.Offset(i - 1, CRM_BDGT) = rmcd(i).rgcd(1).total_BDGT
-            r.Offset(i - 1, CRM_NMG) = rmcd(i).rgcd(1).total_BDGT_NMG
-            r.Offset(i - 1, CRM_HIR) = rmcd(i).rgcd(1).total_HIR
-            r.Offset(i - 1, CRM_TER) = rmcd(i).rgcd(1).total_TER
-            r.Offset(i - 1, CRM_CAR) = rmcd(i).rgcd(1).total_ACS
-            r.Offset(i - 1, CRM_FACT) = rmcd(i).rgcd(1).total_SALE
-            r.Offset(i - 1, CRM_PLAN) = rmcd(i).rgcd(1).sale_PLAN
-            
-            With rmcd(i).rgcd(1)
-                r.Offset(i - 1, CRM_PAT_LPU) = .total_HIR + .total_TER + .total_ACS
-            End With
-            
-            r.Offset(i - 1, CRM_BDGT_1) = rmcd(i).rgcd(1).total_BDGT
-            If rmcd(i).rgcd(1).total_BDGT > 0 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = rmcd(i).rgcd(1).total_SALE / rmcd(i).rgcd(1).total_BDGT
-            End If
-            If r.Offset(i - 1, CRM_BDGT_1 + 1) > 1 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CRM_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CRM_AREA).row, CRM_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CRM_AREA).Column
-
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CRM_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CRM_NAME
-        Range("JUMP") = ""
-    Else
-        btRM_LIST_DO_IT
-    End If
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-<<<<<<
-======================
-mPRJ_QTR
->>>>>>
-Attribute VB_Name = "mPRJ_QTR"
-Sub btPRJ_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("PRJ_ACTION")
-    ent_date = Worksheets(PRJ_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            cmDataImport
-        Case 2
-            Worksheets("RM_LIST").setEnt_date (Worksheets("PRJ_QTR").getEnt_date())
-            Worksheets("RM_LIST").Range("ret_addr") = "PRJ_QTR"
-            Worksheets("RM_LIST").Select
-        Case 3
-            cmNewReport
-    End Select
-    Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-End Sub
-
-
-<<<<<<
-======================
-mRM_LIST
->>>>>>
-Attribute VB_Name = "mRM_LIST"
-Option Explicit
-
-Public Const CRM_AREA As String = "B12"
-Public Const CRM_NAME As Integer = 0
-Public Const CRM_NAME1 As Integer = 1
-Public Const CRM_NAME2 As Integer = 2
-Public Const CRM_ID As Integer = 3
-Public Const CRM_BEDS As Integer = 4
-Public Const CRM_BDGT As Integer = 5
-Public Const CRM_NMG As Integer = 6
-Public Const CRM_HIR As Integer = 7
-Public Const CRM_TER As Integer = 8
-Public Const CRM_CAR As Integer = 9
-Public Const CRM_FACT As Integer = 10
-Public Const CRM_PLAN As Integer = 11
-Public Const CRM_PAT_LPU As Integer = 16
-Public Const CRM_BDGT_1 As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(CRM As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_LIST")
-        s = "�������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub Rm_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub Rm_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CRM_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub btRM_LIST_RET_IT()
-    With Worksheets("RM_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "PRJ_QTR"
-    End With
-    ThisWorkbook.Worksheets("PRJ_QTR").Activate
-End Sub
-
-
-Sub btRM_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rm_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("RM_LIST_ACTION")
-    With Worksheets("RM_LIST")
-        rm_id = .getCurrentRM_ID()
-        
-        Select Case i
-            Case 1:
-                .SelectRM_QTR rm_id
-            Case 2:
-                .SelectREP_LIST rm_id
-            End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mImport2
->>>>>>
-Attribute VB_Name = "mImport2"
-Option Explicit
-
-Sub FOpen()
-    Dim flist As String
-    Dim fileToOpen, s
-    flist = ""
-    fileToOpen = Application _
-        .GetOpenFileName("Data Files (*.mdb), mr*.mdb", Title:="������ ������", MultiSelect:=True)
-    If fileToOpen <> False Then
-        For Each s In fileToOpen
-            flist = flist & s & "; "
-        Next s
-        MsgBox "Open " & flist
-    End If
-End Sub
-
-Sub t2()
-Dim d As ImprtDB
-Set d = New ImprtDB
-d.Show
-
-End Sub
-
-<<<<<<
-======================
-ImprtDB
->>>>>>
-Attribute VB_Name = "ImprtDB"
-Attribute VB_Base = "0{67FA6A28-8370-4981-8F01-1A9079245761}{ECFCB43F-B241-4CD9-9CB3-2A981933173D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-  "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-  lStructSize As Long
-  hWndOwner As Long
-  hInstance As Long
-  lpstrFilter As String
-  lpstrCustomFilter As String
-  nMaxCustFilter As Long
-  nFilterIndex As Long
-  lpstrFile As String
-  nMaxFile As Long
-  lpstrFileTitle As String
-  nMaxFileTitle As Long
-  lpstrInitialDir As String
-  lpstrTitle As String
-  flags As Long
-  nFileOffset As Integer
-  nFileExtension As Integer
-  lpstrDefExt As String
-  lCustData As Long
-  lpfnHook As Long
-  lpTemplateName As String
-End Type
-
-Private Sub Command1_Click()
-  Dim OpenFile As OPENFILENAME
-  Dim lReturn As Long
-  Dim sFilter As String
-  OpenFile.lStructSize = Len(OpenFile)
-'         OpenFile.hwndOwner = Form1.hWnd
-'         OpenFile.hInstance = App.hInstance
-  sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-  OpenFile.lpstrFilter = sFilter
-  OpenFile.nFilterIndex = 1
-  OpenFile.lpstrFile = String(257, 0)
-  OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-  OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-  OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-' OpenFile.lpstrInitialDir = "C:\"
-  OpenFile.lpstrTitle = "������ ������"
-  OpenFile.flags = OFN_HIDEREADONLY + OFN_ALLOWMULTISELECT + OFN_EXPLORER
-  lReturn = GetOpenFileName(OpenFile)
-  If lReturn = 0 Then
-     MsgBox "The User pressed the Cancel Button"
-  Else
-     MsgBox "The user Chose " & Trim(OpenFile.lpstrFile)
-  End If
-End Sub
-
-<<<<<<
-Project Name : 'ClexaneRM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).ClearRMName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "version 1.3"
-Public Const PROGRAM_FILENAME As String = "clexane-rm"
-Public Const PROGRAM_BACKUPNAME As String = "rm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "rm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "mr-ex-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{F2A5159C-AEB6-4066-B85F-339184DAFECD}{712D78F6-CCB6-499E-9674-B992A7482317}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{5D2CB2D2-3E5E-4B6E-9E0C-2EEBA5E10E17}{C891C133-B6B4-43D3-B411-B4A821905C23}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Boolean
-        Dim sum As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BB60E38F-A4AB-4AB4-91D0-40AA798D9F5C}{BE9A54D9-F093-4755-9E17-0B47BB5E2546}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{2C69E842-8DA9-4240-A0A8-F6B0141DC246}{75AAB28C-ADCF-4D1B-9D5A-AF89E80A810C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{BA873669-5C2D-400A-8A8B-572ACD8CCE4C}{D11400A0-9912-4240-A78C-44C33731216A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSet_REGMAN_Record
-    With Worksheets("RM_QTR")
-        .ClearRMName
-        .Range("REP_QTR_INPUT_DATA").ClearContents ' ��� �� ������, �������� ���������
-'        .Range("A1").Select
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-    
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-
-
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Sub ReSetREPRecord()
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbReSetREPRecord dbConnection
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-'Public Sub dbReSetREPRecord(dbConnection As Object)
-'
-'    Dim DeleteSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-       End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmImport()
-    Worksheets(RM_QTR_SHEET).Select
-    ImportData
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("RM_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    End If
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{3EA3C15A-5493-445F-9858-2F241E7D6CEA}{849C1FE1-631A-485D-BE54-A7B73124582C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{B85FF7F1-50C0-4433-BC6F-8A0F2C9BDDDA}{EC2D2B9E-9ED2-4005-A1E9-EF0626D3B7E7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    
-    Unprotect
-    
-    On Error Resume Next
-    
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{EC96F2D1-337D-47DF-B0F1-A6DF3F8CD5CC}{7EB42A63-CBFC-45B0-AE4D-C3E3D8FE7420}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{7B669454-C2AA-4FDF-8311-7ADEDDEF3FF3}{D07A0A02-4923-46C8-8EE8-62769243087D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetLastQTR_fromDB & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRMName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-End Sub
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSet_REGMAN_Record()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSet_REGMAN_Record dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-Public Sub dbReSet_REGMAN_Record(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-End Sub
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� �������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{D5892870-2C88-40C8-A817-AC9B1CF37C2C}{9853EBEA-4E48-41F9-89C0-6F753EB6A0C2}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            ImportData
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub ImportData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        If i > 0 Then
-            Merge_BackUp_All_Data
-            MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-        End If
-    End If
-    Worksheets(RM_QTR_SHEET).update_history
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-Project Name : 'ClexaneMR'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).ClearRepName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(REP_QTR_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-Const CQTR_PAT_ALL As Integer = 16
-Const CQTR_BDGT_ALL As Integer = 17
-
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRepName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-    Range("H5") = ""
-End Sub
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREP
-    
-    cRep = GetREPRecord
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-    
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    i = GetAll_QTR_Records(objQTR, "%")
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList(qcd)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_plan
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_BBL_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-
-Private Sub Worksheet_Activate()
-  
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-    
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CRow_Width Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-    
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub DO_New_qtr()
-    Dim res As Variant
-    Dim objQTR As tQTR
-    Dim s As String
-    s = GetLastQtr
-    objQTR.entry_date = GetNextQTR(s)
-    
-    If objQTR.entry_date = "" Then
-        Exit Sub
-    End If
-    
-    DO_Price_qtr objQTR.entry_date
-
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        Dim qtr As tQTR
-        Dim res As Integer
-        
-        qtr = Get_QTR_Record(ent_date)
-        
-        If qtr.id = 0 Then
-            qtr.entry_date = ent_date
-    
-            With Worksheets(VAR_SHEET)
-                qtr.ClxnH20mg = .Range("ClxnH20mg")
-                qtr.ClxnH40mg = .Range("ClxnH40mg")
-                qtr.ClxnT40mg = .Range("ClxnT40mg")
-                qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-                qtr.ClxnC_IM = .Range("ClxnC_IM")
-            End With
-        End If
-        
-        Dim dlg_nq As dlg_nextQTR
-        Set dlg_nq = New dlg_nextQTR
-        
-        With dlg_nq
-            .tb_qtr_name = qtr.entry_date
-            .tb_bdgt_avts = qtr.sale_plan
-            .tb_qtr_name = qtr.entry_date
-            .tb_ClxnH20mg = qtr.ClxnH20mg
-            .tb_ClxnH40mg = qtr.ClxnH40mg
-            .tb_ClxnT40mg = qtr.ClxnT40mg
-            .tb_ClxnC_ACS = qtr.ClxnC_ACS
-            .tb_ClxnC_IM = qtr.ClxnC_IM
-        End With
-        
-        dlg_nq.Show
-        res = dlg_nq.Tag
-        
-        If res = vbOK Then
-            With dlg_nq
-                If Not IsNumeric(.tb_bdgt_avts) Then
-                    MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                Else
-                    If .tb_bdgt_avts = 0 Then
-                        MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                        Exit Sub
-                    End If
-                End If
-                Dim bool As Boolean
-                bool = IsNumeric(.tb_ClxnH20mg) _
-                    And IsNumeric(.tb_ClxnH40mg) _
-                    And IsNumeric(.tb_ClxnT40mg) _
-                    And IsNumeric(.tb_ClxnC_ACS) _
-                    And IsNumeric(.tb_ClxnC_IM)
-                If Not bool Then
-                    MsgBox "������� ��������� �����", vbOK, PROGRAM_NAME
-                    Exit Sub
-                End If
-                qtr.sale_plan = .tb_bdgt_avts
-                qtr.entry_date = .tb_qtr_name
-                qtr.ClxnH20mg = .tb_ClxnH20mg
-                qtr.ClxnH40mg = .tb_ClxnH40mg
-                qtr.ClxnT40mg = .tb_ClxnT40mg
-                qtr.ClxnC_ACS = .tb_ClxnC_ACS
-                qtr.ClxnC_IM = .tb_ClxnC_IM
-            End With
-            Insert_QTR_Record qtr
-        End If
-    End If
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = False
-            .Range("ent_date") = ent_date
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        Dim i As Integer
-        i = MsgBox("������� ������ �� ������ [" & ent_date & "]?", vbDefaultButton2 + vbOKCancel, PROGRAM_NAME)
-        If i = vbOK Then
-            Dim objQTR As tQTR
-            If ent_date <> "" Then
-                objQTR.entry_date = ent_date
-                objQTR = Get_QTR_Record(ent_date)
-                Delete_QTR_Record objQTR
-                Worksheets(TITLE_SHEET).Select
-                Worksheets(REP_QTR_SHEET).Select
-            End If
-        End If
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            DO_New_qtr
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            dbExport
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    End Select
-    If idx <> 2 Then
-        With ThisWorkbook
-            .Worksheets(TITLE_SHEET).Select
-            .Worksheets(REP_QTR_SHEET).Select
-        End With
-    End If
-End Sub
-
-Sub Delete_qtr()
-    Dim ent_date As String
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    DO_Delete_qtr ent_date
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[MR]"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-    
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-    
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-        
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-                   
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-       
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CINP_WIDTH Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-    
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-        
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    lpu_id = r
-    
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-    
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-    
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-            
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-        
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-        
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-        
-        Case Else
-            Range("JUMP") = ""
-    End Select
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-    
-    is_input_range = INPUT_NO
-    
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-    
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREP
-    
-    ' ent_date = "%" ' % - all records
-    ent_date = getEnt_date
-    
-    objQTR = Get_QTR_Record(ent_date)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-     
-    ' ������� ���
-    Range("C3:C4").ClearContents
-    cRep = GetREPRecord
-    
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_plan
-    
-
-    
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-        
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-            
-         
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_plan
-            
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-            
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{566B33D6-957A-43E4-8444-D8EA3889700C}{42EE65B8-F8C6-4F95-9F52-7738BF6FCEAD}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-    
-        Dim objHir As tHIRURGIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.Count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-        
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-    
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-            Application.ScreenUpdating = False
-            
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-            
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{EBA94131-180E-4709-A2A3-B60D48987620}{47A860A1-BF92-4EBB-A333-AB7E83FAB868}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_plan = Round(Range("F13").Value, 0)
-            
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_plan
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_plan <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("��������� ������� ��������?", vbYesNo, PROGRAM_NAME) Then
-                    Insert_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-    
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_plan
-    
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    objQTR = Get_QTR_Record(ent_date)
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-    
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-        
-        SetupData cLPU
-        
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case INPUT_CHECK
-            
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{E3F10C5A-A4B4-42FF-A2C9-6F8198210A07}{563D0F3D-F79D-48F1-AFE4-A2136809B982}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{137EDDE5-3DB4-4BAD-A245-324DC31ABB36}{3BD7159A-BF6C-403F-B3DF-4834FA9E4D92}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{8EB80D4C-3476-421A-A370-6332A07DE509}{A7542905-C9F8-4F39-AD67-B62A88F8F4E6}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREP
->>>>>>
-Attribute VB_Name = "mREP"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSetREPRecord
-    With Worksheets("REP_QTR")
-        .ClearRepName
-        .Range("REP_QTR_INPUT_DATA").ClearContents
-        .Range("QTR_SEL") = ""
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-        Worksheets("REP_QTR").Range("QTR_SEL") = ""
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cUser As tREP
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cUser = GetREPRecord()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cUser.Region
-        .Range("IDX_CITY") = cUser.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cUser.Region
-        .cbCity = cUser.City
-        .tbFName = cUser.FirstName
-        .tbLName = cUser.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cUser
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        SetREPRecord cUser
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_plan As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim SQL As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_plan = 0
-    End With
-        
-    
-    SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_plan = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_plan = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_plan
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_plan & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPU(allLPU() As tLPU) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPU = dbGetAllLPU(dbConnection, allLPU)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPUbyQTR(allLPU() As tLPU, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPUbyQTR = dbGetAllLPUbyQTR(dbConnection, allLPU, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objLPU.id = 0 then insert else update
-Sub Insert_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    If objLPU.id = 0 Then
-        dbInsert_LPU_Record dbConnection, objLPU
-    Else
-        dbUpdate_LPU_Record dbConnection, objLPU
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub Delete_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDelete_LPU_Record dbConnection, objLPU
-    dbCloseConnection dbConnection
-End Sub
-
-Sub Delete_LPU_RecordQTR(ByRef objLPU As tLPU, ent_date As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-    dbCloseConnection dbConnection
-    
-End Sub
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim SQL As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    SQL = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Sub dbInsert_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-  
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu", dbConnection, 2, 2
-    dbRecordset.addnew
-    dbRecordset("name") = objLPU.name
-    dbRecordset("address") = objLPU.address
-    dbRecordset("rep_id") = objLPU.rep_id
-    dbRecordset("beds") = objLPU.beds
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objLPU.id = dbRecordset("id")
-  
-End Sub
-
-Sub dbUpdate_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu SET " & _
-    "name='" & objLPU.name & "'," & _
-    "address='" & objLPU.address & "'," & _
-    "beds=" & objLPU.beds & "," & _
-    "rep_id=" & objLPU.rep_id& & _
-    " WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-
-Function dbGetAllLPU(dbConnection As Object, allLPU() As tLPU) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu"
-    getAll_LPU_SQL = "SELECT * FROM lpu"
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPU = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAllLPUbyQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim where As String
-    where = "WHERE lpu_budget.entry_date like '" & ent_date & "'"
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget " & where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & where & " AND lpu.id=lpu_budget.lpu_id"
-    
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPUbyQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Sub dbDelete_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu " & _
-    "WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Hir_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Ter_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_ACS_RecordsByLPU_ID dbConnection, objLPU.id
-    
-End Sub
-
-Sub dbDelete_LPU_RecordQTR(dbConnection As Object, ByRef objLPU As tLPU, ent_date As String)
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-End Sub
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-Option Explicit
-
-Public Type tREP
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetREPRecord() As tREP
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetREPRecord = dbGetREPRecord(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub SetREPRecord(cUser As tREP)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSetREPRecord dbConnection, cUser
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSetREPRecord()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSetREPRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGetREPRecord(dbConnection As Object) As tREP
-    
-    Dim SQL As String
-    Dim objREP As tREP
-    
-    objREP.FirstName = ""
-    objREP.LastName = ""
-    objREP.Region = 0
-    objREP.City = 0
-    SQL = "SELECT firstname, lastname, region, city FROM " & _
-          "rep"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREP.FirstName = dbRecordset("firstname")
-        objREP.LastName = dbRecordset("lastname")
-        objREP.Region = dbRecordset("region")
-        objREP.City = dbRecordset("city")
-        
-    End If
-    
-    dbGetREPRecord = objREP
-        
-End Function
-
-Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREP.FirstName & "', " & _
-    "'" & objREP.LastName & "', " & _
-    objREP.Region & ", " & _
-    objREP.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-End Sub
-
-Public Sub dbReSetREPRecord(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("REP_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-'                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = Double2Str(.risk_percent, 3)
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub test()
-    Dim s As String
-    Dim d As Single
-    d = 1235.6789
-    s = Format(d, "####0,00")
-    MsgBox s
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    Dim del_request As Integer
-    Dim allLPU() As tLPU
-    Dim lpu_count As Integer
-    Dim i As Integer
-    Dim tmp_LPU_List As Range
-    Dim tmp_LPU_List_Addr As String
-    Dim r_end As Range
-    Dim dlg As Dlg_lpu_card
-    
-    Set dlg = New Dlg_lpu_card
-    
-    lpu_count = GetAllLPU(allLPU)
-    With Worksheets(VAR_SHEET)
-        Set tmp_LPU_List = .Range("tmp_LPU_List")
-        Set r_end = .Range(tmp_LPU_List, tmp_LPU_List.End(xlDown))
-        Set r_end = .Range(r_end, r_end.End(xlToRight))
-        .Range(tmp_LPU_List, r_end).ClearContents
-    End With
-        
-    If lpu_count <> 0 Then
-        dlg.cbxLPU_List_Enable.Enabled = True
-        For i = 1 To UBound(allLPU)
-            tmp_LPU_List.Cells(i, 1) = allLPU(i).name
-            tmp_LPU_List.Cells(i, 2) = allLPU(i).address
-            tmp_LPU_List.Cells(i, 3) = allLPU(i).beds
-            tmp_LPU_List.Cells(i, 4) = allLPU(i).id
-        Next i
-    Else
-        dlg.cbxLPU_List_Enable.Enabled = False
-    End If
-    
-    tmp_LPU_List_Addr = Worksheets(VAR_SHEET).name & "!" & _
-            Worksheets(VAR_SHEET).Range(tmp_LPU_List, tmp_LPU_List.End(xlDown)).address
-
-    With dlg
-        .cbLPU_List.RowSource = tmp_LPU_List_Addr
-        .cbLPU_List.ListIndex = 0
-        .cbxLPU_List_Enable = False
-        .cbLPU_List.Enabled = False
-        If cLPU.id <> 0 Then
-            .cbxLPU_List_Enable.Enabled = False
-        Else
-            If lpu_count <> 0 Then
-                .cbxLPU_List_Enable.Enabled = True
-            Else
-                .cbxLPU_List_Enable.Enabled = False
-            End If
-        End If
-        .tb_lpu_name.Text = cLPU.name
-        .tb_lpu_address.Text = cLPU.address
-        .tbBedsCount = cLPU.beds
-
-        .Tag = vbCancel
-    End With
-    
-    dlg.Show
-    
-    If Not IsNumeric(dlg.Tag) Then
-        Exit Sub
-    End If
-    
-    If dlg.Tag = vbOK Then
-        Dim n As Variant
-        Dim test As Integer
-        test = 0
-        n = dlg.tbBedsCount.Value
-        If Not IsNumeric(n) Then
-            test = 1
-        Else
-            If n = 0 Then
-                test = 1
-            End If
-        End If
-        If test = 0 Then
-            
-            cLPU.name = dlg.tb_lpu_name.Text
-            cLPU.address = dlg.tb_lpu_address.Text
-            cLPU.beds = dlg.tbBedsCount.Value
-                                    
-            If cLPU.name = "" Or cLPU.address = "" Then
-                test = 2
-            End If
-        End If
-        Select Case test
-            Case 0
-                If dlg.cbxLPU_List_Enable.Value = True Then
-                    cLPU.id = tmp_LPU_List.Cells(dlg.cbLPU_List.ListIndex + 1, 4)
-                End If
-                Insert_LPU_Record cLPU
-                ' ��������� ������� ������ ��� ��� � ��������
-                Dim bdgt As tBUDGET
-                bdgt = Get_BDGT_Record(cLPU.id, ent_date)
-                ' ������ ���: ������� ������ ������ � lpu_budget
-                If bdgt.id = 0 Then
-                    bdgt.lpu_id = cLPU.id
-                    bdgt.entry_date = ent_date
-                    Insert_BDGT_Record bdgt
-                End If
-            Case 1
-                MsgBox "������� ��������� ���������� ������ ����� ��� 1!", vbOKOnly, PROGRAM_NAME
-            Case 2
-                MsgBox "������������ � ����� ��� �� ������ ���� �������!", vbOKOnly, PROGRAM_NAME
-        End Select
-    End If
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-    
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-    
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-    
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & "."
-        .Show
-        
-        If .Tag = vbOK Then
-            If .chbDeleteAll.Value Then
-                delete_all = _
-                    MsgBox("��� ������ �� ��� � ������ '" & cLPU.name & _
-                    "' ����� ������� ��������.", vbOK, PROGRAM_NAME)
-                If delete_all = vbOK Then
-                    Delete_LPU_Record cLPU
-                End If
-            Else
-                Delete_LPU_RecordQTR cLPU, ent_date
-            End If
-        End If
-    End With
-    
-    With ThisWorkbook
-        .Worksheets(TITLE_SHEET).Select
-        .Worksheets("LPU_LIST").Select
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Activate
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-        
-    
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id <> 0 And i = 1 Then
-            lpu_id = 0
-        End If
-        If lpu_id = 0 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1, 6
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                If lpu_id <> 0 Then
-                    .SelectLPU_BDGT lpu_id, ent_date
-                    .Range("JUMP") = "LPU_BDGT"
-                End If
-            Case 3
-                If lpu_id <> 0 Then
-                    .SelectLPU_HIR lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_HIR"
-                End If
-            Case 4
-                If lpu_id <> 0 Then
-                    .SelectLPU_TER lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_TER"
-                End If
-            Case 5
-                If lpu_id <> 0 Then
-                    .SelectLPU_C_ACS lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_C_ACS"
-                End If
-        End Select
-    End With
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_plan As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    Else
-        getLast_QTR_SQL = ""
-    End If
-    
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Sub Insert_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTR.id <> 0 Then
-        dbUpdate_QTR_Record dbConnection, objQTR
-    Else
-        dbInsert_QTR_Record dbConnection, objQTR
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTR_Record(ent_date As String) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, ent_date)
-    If i <> 0 Then
-        Get_QTR_Record = allQTR(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records(ByRef All_QTR() As tQTR, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTR_Records = dbGetAll_QTR_Records(dbConnection, All_QTR, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTR_Record dbConnection, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTR.ID <> 0 then updatre else insert
-Sub dbInsert_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTR
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_plan
-        dbRecordset("rep_id") = .rep_id
-        dbRecordset("ClxnH20mg") = .ClxnH20mg
-        dbRecordset("ClxnH40mg") = .ClxnH40mg
-        dbRecordset("ClxnT40mg") = .ClxnT40mg
-        dbRecordset("ClxnC_IM") = .ClxnC_IM
-        dbRecordset("ClxnC_ACS") = .ClxnC_ACS
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTR.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim Update_SQL As String
-    
-    With objQTR
-        Update_SQL = "UPDATE quarter SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rep_id=" & .rep_id & "," & _
-            "sale_plan=" & .sale_plan & "," & _
-            "ClxnH20mg=" & .ClxnH20mg & "," & _
-            "ClxnH40mg=" & .ClxnH40mg & "," & _
-            "ClxnT40mg=" & .ClxnT40mg & "," & _
-            "ClxnC_IM=" & .ClxnC_IM & "," & _
-            "ClxnC_ACS=" & .ClxnC_ACS & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTR_Records(dbConnection As Object, All_QTR() As tQTR, ent_date As String) As Integer
-    
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter WHERE entry_date like '" & ent_date & "'"
-    getAll_QTR_SQL = "SELECT * FROM quarter WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTR_Records = QTR_Count
-    
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim All_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_plan = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 All_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter " & _
-    "WHERE id=" & objQTR.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Hir_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Ter_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_ACS_RecordsByQTR dbConnection, objQTR.entry_date
-       
-End Sub
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList(ByRef qcd() As tQTR_COMMON) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList = dbGet_QTR_CommonList(dbConnection, qcd)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList(dbConnection As Object, ByRef qcd() As tQTR_COMMON) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, "%")
-    dbGet_QTR_CommonList = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_plan
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    On Error GoTo l_exit
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-l_exit:
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-        .EditDirectlyInCell = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{2FC04B4C-EB99-433E-ACDB-A920D02B9B5B}{777B85CC-ADE3-4188-94C8-9E07DA8B5076}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    On Error GoTo ExitLabel
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.Count
-                On Error Resume Next
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{3F7D7D75-90F6-4829-9E24-CA5391BB2A03}{A1A0F296-0D28-4123-8E38-82FA6EE6F2EF}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAllLPUbyQTR(dbConnection, allLPU, objQTR.entry_date)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-   
-    Unprotect
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-        
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{91AE5FA0-01C7-4C10-9E5F-D1D2DDF29401}{5726592A-BC0A-4E79-A963-35D354045716}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{FB055133-927F-41FF-BC90-442833A40591}{11BCAB43-1EDD-440B-AB0E-20CD6E42E11A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tID_REP
-    id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Public Type tID_REP_COMMON
-    id_rep As tID_REP
-    i_qtr As Long
-    qtrs As tQTR_COMMON
-End Type
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim last_qtr As String
-    
-    On Error GoTo ErrHandler
-    
-    last_qtr = GetLastQTR_fromDB
-    If last_qtr = "" Then
-        MsgBox "��� ������� � ���� ������. ������� ����������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & last_qtr & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub t()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Save
-End Sub
-
-Private Sub Workbook_Open()
-    FindRestoreData
-End Sub
-
-Sub FindRestoreData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim dbname As String
-    Dim caption As String
-    caption = PROGRAM_NAME + " " + PROGRAM_VERSION
-    If MsgBox("�������������� ������. ����������?", vbYesNo, caption) = vbYes Then
-        def_dir = "C:\CLEXANE"
-        If GetDBName(def_dir, dbname) Then
-            HWReset dbname
-            MsgBox "������ � ����� " + dbname + " ������������� :)", vbOKOnly, caption
-        Else
-            MsgBox "����� ��� ���������"
-        End If
-    End If
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-mDataBase
->>>>>>
-Attribute VB_Name = "mDataBase"
-Option Explicit
-
-Sub dbOpenConnection(dbConnection As Object, dbname As String)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = dbname
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Sub HWReset(dbname As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection, dbname
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-mGetDBName
->>>>>>
-Attribute VB_Name = "mGetDBName"
-Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetDBName(DB_dir As String, dbname As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "clexane*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "����������� ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetDBName = False
-        dbname = ""
-    Else
-        GetDBName = True
-        Dim flist() As String
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        dbname = flist(0)
-    End If
-End Function
-
-
-<<<<<<
-Project Name : 'ClexaneRM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).ClearRMName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .Range("ent_date") = ent_date
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[RM]"
-Public Const PROGRAM_VERSION As String = "version 1.3"
-Public Const PROGRAM_FILENAME As String = "clexane-rm"
-Public Const PROGRAM_BACKUPNAME As String = "rm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "rm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "mr-ex-*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("REP_ID") = r_id
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim r_id As Long
-    r_id = Range("REP_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("REP_ID") = r_id
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{F2A5159C-AEB6-4066-B85F-339184DAFECD}{712D78F6-CCB6-499E-9674-B992A7482317}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{5D2CB2D2-3E5E-4B6E-9E0C-2EEBA5E10E17}{C891C133-B6B4-43D3-B411-B4A821905C23}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim test As Boolean
-        Dim sum As Long
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id)
-
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BB60E38F-A4AB-4AB4-91D0-40AA798D9F5C}{BE9A54D9-F093-4755-9E17-0B47BB5E2546}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{2C69E842-8DA9-4240-A0A8-F6B0141DC246}{75AAB28C-ADCF-4D1B-9D5A-AF89E80A810C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{BA873669-5C2D-400A-8A8B-572ACD8CCE4C}{D11400A0-9912-4240-A78C-44C33731216A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSet_REGMAN_Record
-    With Worksheets("RM_QTR")
-        .ClearRMName
-        .Range("REP_QTR_INPUT_DATA").ClearContents ' ��� �� ������, �������� ���������
-'        .Range("A1").Select
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cREGMAN As tREGMAN
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cREGMAN = Get_REGMAN_Record()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cREGMAN.Region
-        .Range("IDX_CITY") = cREGMAN.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cREGMAN.Region
-        .cbCity = cREGMAN.City
-        .tbFName = cREGMAN.FirstName
-        .tbLName = cREGMAN.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-    
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cREGMAN
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        Set_REGMAN_Record cREGMAN
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-
-
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id AND lpu.rep_id=" & rep_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Sub ReSetREPRecord()
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbReSetREPRecord dbConnection
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-'Public Sub dbReSetREPRecord(dbConnection As Object)
-'
-'    Dim DeleteSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-       End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmImport()
-    Worksheets(RM_QTR_SHEET).Select
-    ImportData
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("RM_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & " �� ���������."
-        .Show
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id
-    getAll_QTR_SQL = "SELECT * FROM quarter " & _
-    "WHERE entry_date like '" & ent_date & "' AND rep_id=" & rep_id & " ORDER BY entry_date"
-
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    End If
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{3EA3C15A-5493-445F-9858-2F241E7D6CEA}{849C1FE1-631A-485D-BE54-A7B73124582C}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{B85FF7F1-50C0-4433-BC6F-8A0F2C9BDDDA}{EC2D2B9E-9ED2-4005-A1E9-EF0626D3B7E7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    
-    Unprotect
-    
-    On Error Resume Next
-    
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{EC96F2D1-337D-47DF-B0F1-A6DF3F8CD5CC}{7EB42A63-CBFC-45B0-AE4D-C3E3D8FE7420}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{7B669454-C2AA-4FDF-8311-7ADEDDEF3FF3}{D07A0A02-4923-46C8-8EE8-62769243087D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT rep_id, firstname, lastname, region, city FROM " & _
-          "rep WHERE rep_id=" & id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetLastQTR_fromDB & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRMName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-End Sub
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect UserInterfaceOnly:=True
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "RM_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record() As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSet_REGMAN_Record dbConnection, cREGMAN
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSet_REGMAN_Record()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSet_REGMAN_Record dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    sql = "SELECT firstname, lastname, region, city FROM " & _
-          "reg_man"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREGMAN.FirstName & "', " & _
-    "'" & objREGMAN.LastName & "', " & _
-    objREGMAN.Region & ", " & _
-    objREGMAN.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-Public Sub dbReSet_REGMAN_Record(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM reg_man"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-End Sub
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    name As String
-End Type
-
-Public Type tDBTABLE
-    name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).name = "entry_date"
-    tables(1).field(2).name = "bdgt_NMG"
-    tables(1).field(3).name = "bdgt_NFG"
-    tables(1).field(4).name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).name = "entry_date"
-    tables(2).field(2).name = "operations_per_quarter"
-    tables(2).field(3).name = "risk_percent"
-    tables(2).field(4).name = "patients_with_risk_ON"
-    tables(2).field(5).name = "patients_ambulator"
-    tables(2).field(6).name = "patients_ambulator_nmg"
-    tables(2).field(7).name = "patients_ambulator_clexan"
-    tables(2).field(8).name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).name = "patients_stationar_nmg"
-    tables(2).field(11).name = "patients_stationar_clexan"
-    tables(2).field(12).name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).name = "entry_date"
-    tables(3).field(2).name = "patients_with_geparins"
-    tables(3).field(3).name = "patients_per_quarter"
-    tables(3).field(4).name = "patients_stationar_nmg"
-    tables(3).field(5).name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).name = "entry_date"
-    tables(4).field(2).name = "patients_with_geparins"
-    tables(4).field(3).name = "patients_per_quarter"
-    tables(4).field(4).name = "patients_stationar_nmg"
-    tables(4).field(5).name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).name = "entry_date"
-    tables(5).field(2).name = "patients_per_quarter"
-    tables(5).field(3).name = "risk_percent"
-    tables(5).field(4).name = "patients_with_risk_ON"
-    tables(5).field(5).name = "patients_ambulator"
-    tables(5).field(6).name = "patients_ambulator_nmg"
-    tables(5).field(7).name = "patients_ambulator_clexan"
-    tables(5).field(8).name = "patients_stationar_nmg"
-    tables(5).field(9).name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).name) = getRS(tables(tbl_idx).field(fld_idx).name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� �������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 8)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-'    Dim Engine As Object
-'    Set Engine = CreateObject("JRO.JetEngine")
-'    Engine.CompactDatabase "Password=password;Data Source=" & access_file_full_path, _
-'    "Password=password;Data Source=c:\tmp\1.mdb"
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{D5892870-2C88-40C8-A817-AC9B1CF37C2C}{9853EBEA-4E48-41F9-89C0-6F753EB6A0C2}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("ent_date") = ent_date
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim r_id As Long
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date)
-
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-Public Const CREP_PAT_ALL As Integer = 16
-
-
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    ThisWorkbook.Worksheets("RM_QTR").Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_rep_count As Integer
-            current_rep_count = getREGION_by_QTR(q_date(i), reg_data(i))
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-Function getAllQTRNames(ByRef qtr_lst() As String) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tREPID_COMMON
-    rep_count = Get_REP_CommonList_by_QTR(reps, ent_date)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .qtrs(1).c_bdgt_NFG + .qtrs(1).c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .qtrs(1).c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtrs(1).c_sale_PLAN
-                treg.total_SALE = treg.total_SALE + .qtrs(1).c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .qtrs(1).c_pat_HIR
-                treg.total_TER = treg.total_TER + .qtrs(1).c_pat_TER
-                treg.total_ACS = treg.total_ACS + .qtrs(1).c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .qtrs(1).i_lcd
-                treg.total_BEDS = treg.total_BEDS + .qtrs(1).c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            ImportData
-        Case 2
-            Worksheets("REP_LIST").Select
-        Case 3
-            cmExport
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub ImportData()
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        If i > 0 Then
-            Merge_BackUp_All_Data
-            MergeGlobal db_list, GetWBPath(ThisWorkbook.FullName) & "clexane-rm.mdb"
-        End If
-    End If
-    Worksheets(RM_QTR_SHEET).update_history
-End Sub
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & "mr*.mdb" & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-Project Name : 'ClexanePM'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    Application.ScreenUpdating = True
-'    CheckUser
-
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).update_history
-    Application.Calculate
-
-End Sub
-
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(TITLE_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "QTR_SEL"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetAll_QTR_Records_by_REP(objQTR, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList_by_REP(qcd, "%", cRep.rep_id, rm_id)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_PLAN
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub NoFunc()
-    MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    Dim qtr As tQTR
-    Dim res As Integer
-    Dim cRep As tREPID
-    Dim rm_id As Long
-
-    rm_id = Worksheets(REP_QTR_SHEET).Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    qtr = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    If qtr.id = 0 Then
-        qtr.entry_date = ent_date
-
-        With Worksheets(VAR_SHEET)
-            qtr.ClxnH20mg = .Range("ClxnH20mg")
-            qtr.ClxnH40mg = .Range("ClxnH40mg")
-            qtr.ClxnT40mg = .Range("ClxnT40mg")
-            qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-            qtr.ClxnC_IM = .Range("ClxnC_IM")
-        End With
-    End If
-
-    Dim dlg_nq As dlg_nextQTR
-    Set dlg_nq = New dlg_nextQTR
-
-    With dlg_nq
-        .tb_qtr_name = qtr.entry_date
-        .tb_bdgt_avts = qtr.sale_PLAN
-        .tb_qtr_name = qtr.entry_date
-        .tb_ClxnH20mg = qtr.ClxnH20mg
-        .tb_ClxnH40mg = qtr.ClxnH40mg
-        .tb_ClxnT40mg = qtr.ClxnT40mg
-        .tb_ClxnC_ACS = qtr.ClxnC_ACS
-        .tb_ClxnC_IM = qtr.ClxnC_IM
-    End With
-
-    dlg_nq.Show
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        NoFunc
-    Else
-        Dim rep_id As Long
-        rep_id = Worksheets(REP_QTR_SHEET).Range("REP_ID")
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = True
-            .setEnt_date (ent_date)
-            .Range("REP_ID") = rep_id
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        MsgBox "������� ������ �� ������ [" & ent_date & "] ������ ", vbOKOnly, PROGRAM_NAME
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).getEnt_date()
-    Select Case idx
-        Case 1
-            NoFunc
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            NoFunc
-    End Select
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-Sub Delete_qtr()
-'    Dim ent_date As String
-'    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-'    DO_Delete_qtr ent_date
-End Sub
-
-Sub btREP_QTR_RET_IT()
-    Dim s As String
-    With Worksheets("REP_QTR")
-        .Range("LAST_FOCUS") = ""
-        s = .Range("ret_addr")
-        .Range("ret_addr") = ""
-    End With
-    If s <> "" Then
-        ThisWorkbook.Worksheets(s).Select
-    Else
-        ThisWorkbook.Worksheets(RM_QTR_SHEET).Select
-    End If
-End Sub
-
-
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public ppReport As New cPPReport
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[PM]"
-Public Const PROGRAM_VERSION As String = "Clexane[PM] ver 1.1"
-Public Const PROGRAM_FILENAME As String = "clexane-pm"
-Public Const PROGRAM_BACKUPNAME As String = "pm-backup-"
-Public Const PROGRAM_EXPORTNAME As String = "pm-ex-"
-Public Const PROGRAM_IMPORTNAME As String = "rm-ex*"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-Public Const CHART_DEF_TITLE As String = "* * *"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20031207
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O41"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-Public Const RM_QTR_SHEET As String = "RM_QTR"
-Public Const PRJ_QTR_SHEET As String = "PRJ_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-Function time_correct(end_date As Long, ByVal theDate As Date) As Boolean
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-    If end_date = NO_ESTIMATION_DATE Then
-        time_correct = True
-        Exit Function
-    End If
-    
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    
-    time_correct = CurDate <= end_date
-    
-End Function
-
-Sub EnableRun(end_date As Long)
-    If Not time_correct(end_date, Now) Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-Sub t()
-    EnableRun ESTIMATION_DATE
-End Sub
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Sub OpenPPT()
-    ppReport.ReportView
-End Sub
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetWBName(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBName = Right(FullName, s_len - pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.Name = VAR_SHEET Or sh.Name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    SelectLPU_BDGT lpu_id, ent_date
-End Sub
-
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .setEnt_date (ent_date)
-            .Range("lpu_id") = lpu_id
-            .Range("REP_ID") = rep_id
-            .Range("RM_ID") = rm_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("lpu_id") = lpu_id
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    
-    Dim rep_id As Long
-    rep_id = Range("REP_ID")
-    
-    Dim rm_id As Long
-    rm_id = Range("RM_ID")
-    
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .setEnt_date (ent_date)
-        .Range("RM_ID") = rm_id
-        .Range("REP_ID") = rep_id
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    lpu_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        Case Else
-            Range("JUMP") = ""
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    ent_date = getEnt_date
-
-'     ent_date = "%" ' % - all records
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-
-'     ������� ���
-    Range("C3:C4").ClearContents
-
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_PLAN
-
-
-
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.Name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-
-
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_PLAN
-
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{32FB0F3D-6884-41DC-99DB-E2C55B2257C4}{DED79A66-DA60-4CCC-9003-082480235D55}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-
-        Dim objHir As tHIRURGIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S38"
-
-Sub PrintCopy()
-    Range("A1:M26").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    Dim cRep As tREPID
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), rm_id)
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-    
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-
-        qtr = Get_QTR_Record_by_REP(.entry_date, cRep.rep_id, cRep.rm_id)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-
-    Range("h_DepFlag") = False
-
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id, Range("RM_ID"))
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.Name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"), Range("RM_ID"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{0DC9E035-CE0A-49FF-85A2-A4EC5FF8FE96}{D54DDC8A-1EE2-4BB3-8B94-343B521AF098}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const LOCAL_ENT_DATE As String = "S15"
-
-Sub PrintCopy()
-    Range("B1:K21").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_PLAN = Round(Range("F13").Value, 0)
-
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_PLAN
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_PLAN <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("������� ������ �� ����!", vbYesNo, PROGRAM_NAME) Then
-                    Delete_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_PLAN
-
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    Dim cRep As tREPID
-    
-    cRep = Get_REPID_Record(Range("REP_ID"), Range("RM_ID"))
-    
-    If cRep.rep_id = 0 Then
-        Exit Sub
-    End If
-
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    
-    objQTR = Get_QTR_Record_by_REP(ent_date, cRep.rep_id, cRep.rm_id)
-
-    objLPU = Get_LPU_Record(id, Range("RM_ID"))
-    Get_LPU_Common cLPU, objLPU, objQTR
-
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.Name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-
-        SetupData cLPU
-
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case INPUT_CHECK
-
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{BFB4547C-96A7-4739-AA0A-CEF1E35E2BDC}{C3D618A3-9410-4BC7-9D93-3B049D361132}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.Name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-    sh.Range("ret_addr") = ""
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{9AAD262F-A6C4-4912-9C58-D7A2071181B8}{9470F4EB-DA9F-4584-9159-D09319548D21}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{A8FBEE9C-DE59-49DE-971D-07BC9C0E9BD2}{C712732B-D8E4-4C2D-8E78-AC90968E0CD7}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .Name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREGMAN
->>>>>>
-Attribute VB_Name = "mREGMAN"
-Option Explicit
-
-Sub hw_reset()
-    Dim rs As Range
-    Dim re As Object
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    With Application
-        .DisplayAlerts = False
-        .Quit
-    End With
-End Sub
-
-Sub CheckUser()
-    If Range("HW_Number") = "" Then
-        StoreHWInfo
-    End If
-    If CheckHWInfo <> True Then
-        MsgBox "2"
-        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-    Else
-        SetupUser
-    End If
-End Sub
-
-
-Sub SetupUser()
-'    Dim cREGMAN As tREGMAN
-'    Dim idx As Integer
-'    Dim dlg_ui As UserInfo
-'
-'    Set dlg_ui = New UserInfo
-'
-'    cREGMAN = Get_REGMAN_Record()
-'
-'    With ThisWorkbook.Worksheets(REGS_SHEET)
-'        .Range("IDX_REGION") = cREGMAN.Region
-'        .Range("IDX_CITY") = cREGMAN.City
-'    End With
-'
-'    With dlg_ui
-'        .cbRegion = cREGMAN.Region
-'        .cbCity = cREGMAN.City
-'        .tbFName = cREGMAN.FirstName
-'        .tbLName = cREGMAN.LastName
-'    End With
-'
-'    dlg_ui.Show
-'    Worksheets(REGS_SHEET).Calculate
-'
-'    If dlg_ui.Tag = vbOK Then
-'        With cREGMAN
-'            .Region = dlg_ui.cbRegion.Value
-'            .City = dlg_ui.cbCity.Value
-'            .FirstName = dlg_ui.tbFName.Value
-'            .LastName = dlg_ui.tbLName.Value
-'        End With
-'        Set_REGMAN_Record cREGMAN
-'    Else
-'        cmAbout
-'        With Application
-'            .DisplayAlerts = False
-'            .Quit
-'        End With
-'    End If
-End Sub
-
-Sub StoreHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    Set r = Range("HW_Number")
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then
-            r = d.SerialNumber
-            Set r = r.Offset(1, 0)
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    
-    UpdateHWRecords objHW
-End Sub
-
-Function CheckHWInfo()
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim objHW() As Long
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    
-    CheckHWInfo = False
-    
-    i = GetHWRecords(objHW)
-    If i = 0 And Range("HW_Number") <> 0 Then
-        Exit Function
-    End If
-    For Each d In dc
-        If d.drivetype = 2 Then
-            Set r = Range("HW_Number")
-            Do While r <> ""
-                If r = d.SerialNumber Then
-                    For i = 1 To UBound(objHW)
-                        If d.SerialNumber = objHW(i) Then
-                            CheckHWInfo = True
-                            Exit Function
-                        End If
-                    Next i
-                End If
-                Set r = r.Offset(1, 0)
-            Loop
-        End If
-    Next
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    rm_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_PLAN As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String, rm_id As Long) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String, rm_id As Long) As tBUDGET
-    
-    Dim sql As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .rm_id = rm_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_PLAN = 0
-    End With
-        
-    
-    sql = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_PLAN = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_PLAN = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_PLAN
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_PLAN & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    rm_id As Long
-    Name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long, rm_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_LPU_byQTR(allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_LPU_byQTR = dbGetAll_LPU_byQTR(dbConnection, allLPU, ent_date, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long, rm_id As Long) As tLPU
-    
-    Dim sql As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.Name = ""
-    objLPU.address = ""
-    
-    sql = "SELECT * FROM lpu WHERE id=" & lpu_id & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.Name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.rm_id = dbRecordset("rm_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Function dbGetAll_LPU_byQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim Where As String
-    Where = "WHERE lpu_budget.entry_date like '" & ent_date & "'" & " AND lpu.id=lpu_budget.lpu_id " & _
-    "AND lpu.rep_id=" & rep_id & " AND lpu.rm_id=lpu_budget.rm_id AND lpu.rm_id=" & rm_id
-
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget, lpu " & Where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds, lpu.rm_id AS rm_id " & _
-    "FROM lpu, lpu_budget " & Where
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_LPU_byQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .Name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-'Option Explicit
-'
-'Public Type tREP
-'    FirstName As String
-'    LastName As String
-'    Region As Integer
-'    City As Integer
-'End Type
-'
-'Function GetREPRecord() As tREP
-'    Dim dbConnection As Object
-'
-'    dbOpenConnection dbConnection
-'    GetREPRecord = dbGetREPRecord(dbConnection)
-'    dbCloseConnection dbConnection
-'End Function
-'
-'Sub SetREPRecord(cUser As tREP)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSetREPRecord dbConnection, cUser
-'    dbCloseConnection dbConnection
-'End Sub
-'
-'Public Function dbGetREPRecord(dbConnection As Object) As tREP
-'
-'    Dim SQL As String
-'    Dim objREP As tREP
-'
-'    objREP.FirstName = ""
-'    objREP.LastName = ""
-'    objREP.Region = 0
-'    objREP.City = 0
-'    SQL = "SELECT firstname, lastname, region, city FROM " & _
-'          "rep"
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open SQL, dbConnection
-'    ', 3, 3
-'    If Not dbRecordset.BOF Then
-'
-'        objREP.FirstName = dbRecordset("firstname")
-'        objREP.LastName = dbRecordset("lastname")
-'        objREP.Region = dbRecordset("region")
-'        objREP.City = dbRecordset("city")
-'
-'    End If
-'
-'    dbGetREPRecord = objREP
-'
-'End Function
-'
-'Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-'
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM rep"
-'    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREP.FirstName & "', " & _
-'    "'" & objREP.LastName & "', " & _
-'    objREP.Region & ", " & _
-'    objREP.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-'
-'End Sub
-'
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEL ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub GetState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.Name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-
-
-<<<<<<
-======================
-cdbRM
->>>>>>
-Attribute VB_Name = "cdbRM"
-Option Explicit
-
-Public Type tRMID_COMMON
-    rm As tREGMAN
-    rgcd_count As Integer
-    rgcd() As tREGION
-End Type
-
-Function Get_RM_CommonList_by_QTR(ByRef rmcd() As tRMID_COMMON, ent_date As String) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_RM_CommonList_by_QTR = dbGet_RM_CommonList_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_RM_CommonList_by_QTR(dbConnection As Object, ByRef rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    ' �������� ������ RM-��
-    Dim count As Integer
-    count = db_get_All_RM_by_QTR(dbConnection, rmcd(), ent_date)
-    
-    Dim i As Integer
-    For i = 1 To count
-        rmcd(i).rgcd_count = 1
-        ReDim rmcd(i).rgcd(1 To 1)
-        getREGION_by_QTR ent_date, rmcd(i).rgcd(1), rmcd(i).rm.rm_id
-    Next i
-    dbGet_RM_CommonList_by_QTR = count
-End Function
-
-Function db_get_All_RM_by_QTR(dbConnection As Object, rmcd() As tRMID_COMMON, ent_date As String) As Integer
-    
-    Dim count_sql As String
-    Dim get_sql As String
-    Dim rs As Object
-    Dim RM_Count As Integer
-        
-    count_sql = "SELECT COUNT(*) AS RM_TOTAL FROM reg_man"
-    get_sql = "SELECT * FROM reg_man"
-    Set rs = CreateObject("ADODB.Recordset")
-    rs.Open count_sql, dbConnection
-    
-    If Not rs.BOF Then
-        RM_Count = rs("RM_TOTAL")
-    End If
-    
-    rs.Close
-    
-     db_get_All_RM_by_QTR = RM_Count
-    
-    If RM_Count > 0 Then
-        'we have records
-        ReDim rmcd(1 To RM_Count)
-        Dim index As Long
-        index = 1
-        rs.Open get_sql, dbConnection
-        
-        If Not rs.BOF Then
-             Do While Not rs.EOF
-                 Dim tmp_rmcd As tRMID_COMMON
-                 With tmp_rmcd
-                    .rgcd_count = 0
-                    .rm.City = rs("city")
-                    .rm.FirstName = rs("firstname")
-                    .rm.LastName = rs("lastname")
-                    .rm.rm_id = rs("mgr_id")
-                    .rm.Region = rs("region")
-                 End With
-                 
-                 rmcd(index) = tmp_rmcd
-                 index = index + 1
-                 rs.MoveNext
-             Loop
-        End If
-    End If
-    
-End Function
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-           With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub CreateExtCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom extendet commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Import data"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmDataImport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-             With .Add(msoControlPopup)
-                .Caption = "&Report"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&New Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 18
-                        .OnAction = "cmNewReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Open Report"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 23
-                        .OnAction = "cmOpenReport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Close && Save"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 3
-                        .OnAction = "cmCloseReport"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Add New Slide"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 280
-                .OnAction = "cmAddSlide"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        Application.ScreenUpdating = False
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        xlRestoreView
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        Application.ScreenUpdating = True
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmNewReport()
-    ppReport.CreateReport
-    MsgBox "����� ����� ������", vbInformation + vbOKOnly, PROGRAM_NAME
-    CreateExtCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmOpenReport()
-    Dim fileToOpen
-    Dim s As String
-    fileToOpen = Application _
-        .GetOpenFileName("Report Files (*.ppt), *.ppt", title:="Report OPen", MultiSelect:=False)
-    If fileToOpen <> False Then
-        s = fileToOpen
-        ppReport.OpenReport s
-        CreateExtCommandBar theApp:=ThisWorkbook.Application
-    End If
-End Sub
-
-Sub cmCloseReport()
-    On Error Resume Next
-    ppReport.SaveReport
-    CreateCommandBar theApp:=ThisWorkbook.Application
-End Sub
-
-Sub cmAddSlide()
-    ThisWorkbook.ActiveSheet.PrintCopy
-    ppReport.InsertSlide
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("PRJ_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    With Application
-        .Caption = PROGRAM_NAME
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .GetState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Unprotect
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "' AND rm_id=" & rm_id
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("LPU_LIST")
-        s = .Range("C4") & " " & .Range("C3") & ", " & .Range("G4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-End Sub
-
-Sub btLPU_DEL_IT()
-'    Dim cLPU As tLPU
-'    Dim ent_date As String
-'    Dim delete_all As Integer
-'    Dim dlg_del As dlg_LPU_delete
-'
-'    With Worksheets("LPU_LIST")
-'        ent_date = .Range("ent_date")
-'        cLPU.id = .getCurrentLPU_ID()
-'    End With
-'
-'    If cLPU.id = 0 Then
-'        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-'        Exit Sub
-'    End If
-'    cLPU = Get_LPU_Record(cLPU.id)
-'
-'    Set dlg_del = New dlg_LPU_delete
-'    With dlg_del
-'        .chbDeleteQTR.Value = True
-'        .chbDeleteAll.Value = False
-'        .lComment = ent_date & ": �������� ��� '" _
-'        & cLPU.Name & "', �������������� �� ������:" _
-'        & cLPU.address & " �� ���������."
-'        .Show
-'    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        
-        Wks_select .Range("ret_addr")
-    End With
-
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-
-
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id = 0 And i <> 6 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 2
-                .SelectLPU_BDGT lpu_id, ent_date
-                .Range("JUMP") = "LPU_BDGT"
-            Case 3
-                .SelectLPU_HIR lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_HIR"
-
-            Case 4
-                .SelectLPU_TER lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_TER"
-
-            Case 5
-                .SelectLPU_C_ACS lpu_id, ent_date
-                .Range("JUMP") = "LPU_CLSN_C_ACS"
-
-        End Select
-    End With
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    rm_id As Long
-    sale_PLAN As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-Function Get_QTR_Record(ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_QTR_Record = dbGet_QTR_Record(dbConnection, QTR_ID, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_Record(dbConnection As Object, ByVal QTR_ID As Long, rm_id As Long) As tQTR
-    
-    Dim sql As String
-    Dim objQTR As tQTR
-    
-    With objQTR
-        .ClxnC_ACS = 0
-        .ClxnC_IM = 0
-        .ClxnH20mg = 0
-        .ClxnH40mg = 0
-        .ClxnT40mg = 0
-        .entry_date = ""
-        .id = QTR_ID
-        .rm_id = rm_id
-    End With
-    
-    sql = "SELECT * FROM quarter WHERE id=" & QTR_ID & " AND rm_id=" & rm_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objQTR.entry_date = dbRecordset("entry_date")
-        objQTR.rep_id = dbRecordset("rep_id")
-        objQTR.rm_id = dbRecordset("rm_id")
-        objQTR.sale_PLAN = dbRecordset("sale_plan")
-        objQTR.ClxnH20mg = dbRecordset("ClxnH20mg")
-        objQTR.ClxnH40mg = dbRecordset("ClxnH40mg")
-        objQTR.ClxnT40mg = dbRecordset("ClxnT40mg")
-        objQTR.ClxnC_IM = dbRecordset("ClxnC_IM")
-        objQTR.ClxnC_ACS = dbRecordset("ClxnC_ACS")
-        objQTR.id = dbRecordset("id")
-    End If
-    
-    dbGet_QTR_Record = objQTR
-
-End Function
-
-
-Function Get_QTR_Record_by_REP(ent_date As String, rep_id As Long, rm_id As Long) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-
-    dbOpenConnection dbConnection
-
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    If i <> 0 Then
-        Get_QTR_Record_by_REP = allQTR(1)
-    End If
-
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records_by_REP(ByRef all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-
-    GetAll_QTR_Records_by_REP = dbGetAll_QTR_Records_By_REP(dbConnection, all_QTR, ent_date, rep_id, rm_id)
-
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGetAll_QTR_Records_By_REP(dbConnection As Object, all_QTR() As tQTR, ent_date As String, rep_id As Long, rm_id As Long) As Integer
-
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    Dim rep_sql As String
-    Dim rm_sql As String
-    
-    rep_sql = ""
-    rm_sql = ""
-    
-    If rep_id <> 0 Then
-        rep_sql = " AND rep_id=" & rep_id
-    End If
-    
-    If rm_id <> 0 Then
-        rm_sql = " AND rm_id=" & rm_id
-    End If
-    
-    
-        getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql
-        getAll_QTR_SQL = "SELECT * FROM quarter " & _
-        "WHERE entry_date like '" & ent_date & "' " & rep_sql & rm_sql & " ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-
-    dbRecordset.Close
-
-    dbGetAll_QTR_Records_By_REP = QTR_Count
-
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim all_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-
-                 all_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList_by_REP(ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList_by_REP = dbGet_QTR_CommonList_by_REP(dbConnection, qcd, ent_date, rep_id, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList_by_REP(dbConnection As Object, ByRef qcd() As tQTR_COMMON, ent_date As String, rep_id As Long, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records_By_REP(dbConnection, allQTR, ent_date, rep_id, rm_id)
-    dbGet_QTR_CommonList_by_REP = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_PLAN
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{92648543-CB84-4B6B-BEB3-539AE7EF9D84}{7E20E3E3-027A-483B-A14D-AA9EA5398ACC}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "��������� �����: " & Range("title")
-    Range("view_key") = False
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.count
-                On Error GoTo ExitLabel
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(%): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{067FED69-B41E-427D-AF59-5798B8E2E73A}{4C13CAB1-FDCC-4708-89EB-E92EDC125712}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAll_LPU_byQTR(dbConnection, allLPU, objQTR.entry_date, objQTR.rep_id, objQTR.rm_id)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date, objQTR.rm_id)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-    Unprotect
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "���� ������: " & Range("title")
-    
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� ������: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "������� ���: " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{9C81F4D2-4ECF-46F5-999B-9801D572A12F}{B382508B-7F3D-4747-8407-0F75F6F265F5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{EA8CE4CE-AC2E-45BC-BAF8-1429E6242097}{575F0762-04F4-4F86-B98A-8E87E3424B0D}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tREPID
-    rep_id As Long
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetAll_REPID_Records_by_QTR(ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAll_REPID_Records_by_QTR = dbGetAll_REPID_Records_by_QTR(dbConnection, all_REPID, ent_date, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function Get_REPID_Record(rep_id As Long, rm_id As Long) As tREPID
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REPID_Record = dbGet_REPID_Record(dbConnection, rep_id, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_REPID_Records(ByRef all_REPID() As tREPID) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_REPID_Records = dbGetAll_REPID_Records(dbConnection, all_REPID)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function dbGet_REPID_Record(dbConnection As Object, rep_id As Long, rm_id As Long) As tREPID
-    
-    Dim sql As String
-    Dim objREPID As tREPID
-    
-    objREPID.FirstName = ""
-    objREPID.LastName = ""
-    objREPID.Region = 0
-    objREPID.City = 0
-    sql = "SELECT * FROM " & _
-          "rep WHERE rep_id=" & rep_id & " AND rm_id=" & rm_id
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREPID.rep_id = dbRecordset("rep_id")
-        objREPID.rm_id = dbRecordset("rm_id")
-        objREPID.FirstName = dbRecordset("firstname")
-        objREPID.LastName = dbRecordset("lastname")
-        objREPID.Region = dbRecordset("region")
-        objREPID.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REPID_Record = objREPID
-        
-End Function
-
-Function dbGetAll_REPID_Records_by_QTR(dbConnection As Object, ByRef all_REPID() As tREPID, ent_date As String, rm_id As Long) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    Dim Where As String
-    
-    REPID_Count = 0
-    
-    Where = " WHERE lpu_budget.entry_date like '" & ent_date & "' " & _
-        "AND rep.rep_id=lpu.rep_id AND lpu.id=lpu_budget.lpu_id"
-    If rm_id <> 0 Then
-        Where = Where & " AND rep.rm_id=" & rm_id
-    End If
-    
-    getAll_REPID_SQL = "SELECT distinct rep.* FROM rep, lpu, lpu_budget" & Where
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM (" & getAll_REPID_SQL & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records_by_QTR = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAll_REPID_Records(dbConnection As Object, ByRef all_REPID() As tREPID) As Integer
-    
-    Dim getCount_REPID_SQL As String
-    Dim getAll_REPID_SQL As String
-    Dim REPID_Count As Long
-    REPID_Count = 0
-    
-    getCount_REPID_SQL = "SELECT COUNT(*) AS REPID_TOTAL FROM rep"
-    getAll_REPID_SQL = "SELECT * FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_REPID_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        REPID_Count = dbRecordset("REPID_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_REPID_Records = REPID_Count
-    
-    If REPID_Count > 0 Then
-        'we have records
-        ReDim all_REPID(1 To REPID_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_REPID_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_REPID As tREPID
-                 With tmp_REPID
-                    .rep_id = dbRecordset("rep_id")
-                    .rm_id = dbRecordset("rm_id")
-                    .FirstName = dbRecordset("firstname")
-                    .LastName = dbRecordset("lastname")
-                    .Region = dbRecordset("region")
-                    .City = dbRecordset("city")
-                 End With
-                 
-                 all_REPID(index) = tmp_REPID
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim old_file As String
-    
-    On Error GoTo ErrHandler
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    old_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & "*.*"
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.DeleteFile old_file, True
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub testReg()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-======================
-RM_QTR
->>>>>>
-Attribute VB_Name = "RM_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CRGN_QT As Integer = 0
-Const CRGN_PLN As Integer = 2
-Const CRGN_FCT As Integer = 3
-Const CRGN_BDG As Integer = 4
-Const CRGN_LPU As Integer = 5
-Const CRGN_REP As Integer = 6
-Const CRGN_HIR As Integer = 7
-Const CRGN_TER As Integer = 8
-Const CRGN_CRD As Integer = 9
-Const CRGN_CLXN_BDG As Integer = 10
-Const CRGN_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_QTR")
-        s = .Range("D5") & " " & .Range("D4") & ", " & .Range("H4") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objRGN() As tREGION
-    Dim i As Long
-    Dim r As Range
-    Dim cRMan As tREGMAN
-
-    cRMan = Get_REGMAN_Record(Range("RM_ID"))
-    
-    Range("D4") = cRMan.LastName
-    Range("D5") = cRMan.FirstName
-
-    Range("H4") = GetRegionName(cRMan.Region)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objRGN, Range("RM_ID"))
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objRGN)
-            r.Offset(i - 1, CRGN_QT) = objRGN(i).ent_date
-            r.Offset(i - 1, CRGN_FCT) = objRGN(i).total_SALE
-            r.Offset(i - 1, CRGN_PLN) = objRGN(i).sale_PLAN
-            r.Offset(i - 1, CRGN_BDG) = objRGN(i).total_BDGT
-            r.Offset(i - 1, CRGN_LPU) = objRGN(i).total_LPU
-            r.Offset(i - 1, CRGN_REP) = objRGN(i).total_REP
-            r.Offset(i - 1, CRGN_HIR) = objRGN(i).total_HIR
-            r.Offset(i - 1, CRGN_TER) = objRGN(i).total_TER
-            r.Offset(i - 1, CRGN_CRD) = objRGN(i).total_ACS
-            If objRGN(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_BDG) = objRGN(i).total_SALE / objRGN(i).total_BDGT
-            End If
-            If objRGN(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CRGN_CLXN_NMG) = objRGN(i).total_SALE / objRGN(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRGN_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_RM()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(RM_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRGN_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRGN_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRGN_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRGN_CLXN_NMG + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Public Sub cbxRM_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_RM
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_RM
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_RM
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = RM_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CRGN_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-    End If
-    Cancel = True
-    btRM_QTR_Do_IT
-End Sub
-
-<<<<<<
-======================
-dbREG_MAN
->>>>>>
-Attribute VB_Name = "dbREG_MAN"
-Option Explicit
-
-Public Type tREGMAN
-    rm_id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function Get_REGMAN_Record(rm_id As Long) As tREGMAN
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_REGMAN_Record = dbGet_REGMAN_Record(dbConnection, rm_id)
-    dbCloseConnection dbConnection
-End Function
-
-Sub Set_REGMAN_Record(cREGMAN As tREGMAN)
-'    Dim dbConnection As Object
-'    dbOpenConnection dbConnection
-'    dbSet_REGMAN_Record dbConnection, cREGMAN
-'    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_REGMAN_Record(dbConnection As Object, rm_id As Long) As tREGMAN
-    
-    Dim sql As String
-    Dim objREGMAN As tREGMAN
-    
-    objREGMAN.FirstName = ""
-    objREGMAN.LastName = ""
-    objREGMAN.Region = 0
-    objREGMAN.City = 0
-    objREGMAN.rm_id = rm_id
-    sql = "SELECT * FROM " & _
-          "reg_man WHERE mgr_id=" & rm_id
-          
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open sql, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREGMAN.FirstName = dbRecordset("firstname")
-        objREGMAN.LastName = dbRecordset("lastname")
-        objREGMAN.Region = dbRecordset("region")
-        objREGMAN.City = dbRecordset("city")
-        
-    End If
-    
-    dbGet_REGMAN_Record = objREGMAN
-        
-End Function
-
-Public Sub dbSet_REGMAN_Record(dbConnection As Object, ByRef objREGMAN As tREGMAN)
-  
-'    Dim DeleteSQL As String
-'    Dim InsertSQL As String
-'
-'    DeleteSQL = "DELETE FROM reg_man"
-'    InsertSQL = "INSERT INTO reg_man (firstname, lastname, region, city) VALUES (" & _
-'    "'" & objREGMAN.FirstName & "', " & _
-'    "'" & objREGMAN.LastName & "', " & _
-'    objREGMAN.Region & ", " & _
-'    objREGMAN.City & ")"
-'
-'    Dim dbRecordset As Object
-'    Set dbRecordset = CreateObject("ADODB.Recordset")
-'    dbRecordset.Open DeleteSQL, dbConnection
-'    dbRecordset.Open InsertSQL, dbConnection
-       
-End Sub
-
-
-
-<<<<<<
-======================
-dbDatabaseMerge
->>>>>>
-Attribute VB_Name = "dbDatabaseMerge"
-Option Explicit
-
-Public Type tDBFIELD
-    Name As String
-End Type
-
-Public Type tDBTABLE
-    Name As String
-    field() As tDBFIELD
-End Type
-
-
-Function dbGetConnection(dbAccessFileFullPath As String) As Object
-    Dim dbConnection As Object
-    Dim dbAccessFilePasswd As String
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFileFullPath & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    Set dbGetConnection = dbConnection
-End Function
-
-Sub dbCloseOpenedConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteOpenedSQL(dbConnection As Object, sql As String)
-    dbConnection.Execute (sql)
-End Sub
-
-Function dbMergeREP(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM rep"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about rep! This database cannot be merged!!!"
-            dbMergeREP = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "rep", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    
-    dbMergeREP = insertRecordset("rep_id")
-    
-End Function
-
-Sub dbMergeLPU(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getLPU_SQL As String
-    Dim getRecordset As Object
-    Dim idx As Long
-    idx = 1
-    
-    getLPU_SQL = "SELECT * FROM lpu"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getLPU_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            ReDim Preserve objLPU(1 To idx)
-            objLPU(idx).old_lpu_id = getRecordset("id")
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "lpu", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("name") = getRecordset("name")
-            insRS("address") = getRecordset("address")
-            insRS("beds") = getRecordset("beds")
-            insRS.Update
-            insRS.MoveLast
-            'new ID
-            
-            objLPU(idx).new_lpu_id = insRS("id")
-                        
-            idx = idx + 1
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about LPU! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-
-Sub dbMergeLPURelated(objLPU() As tLPUCONVERTION, from_db As Object, to_db As Object)
-
-    ' 6 tables to change
-    Dim tables(1 To 5) As tDBTABLE
-    
-    'lpu budget
-    tables(1).Name = "lpu_budget"
-    ReDim tables(1).field(1 To 4)
-    
-    tables(1).field(1).Name = "entry_date"
-    tables(1).field(2).Name = "bdgt_NMG"
-    tables(1).field(3).Name = "bdgt_NFG"
-    tables(1).field(4).Name = "sale_PLAN"
-    
-    'lpu hir
-    tables(2).Name = "lpu_hir"
-    ReDim tables(2).field(1 To 13)
-    
-    tables(2).field(1).Name = "entry_date"
-    tables(2).field(2).Name = "operations_per_quarter"
-    tables(2).field(3).Name = "risk_percent"
-    tables(2).field(4).Name = "patients_with_risk_ON"
-    tables(2).field(5).Name = "patients_ambulator"
-    tables(2).field(6).Name = "patients_ambulator_nmg"
-    tables(2).field(7).Name = "patients_ambulator_clexan"
-    tables(2).field(8).Name = "patients_ambulator_clexan_40mg"
-    tables(2).field(9).Name = "patients_ambulator_clexan_20mg"
-    tables(2).field(10).Name = "patients_stationar_nmg"
-    tables(2).field(11).Name = "patients_stationar_clexan"
-    tables(2).field(12).Name = "patients_stationar_clexan_40mg"
-    tables(2).field(13).Name = "patients_stationar_clexan_20mg"
-    
-    
-    'lpu acs
-    tables(3).Name = "lpu_acs"
-    ReDim tables(3).field(1 To 5)
-    
-    tables(3).field(1).Name = "entry_date"
-    tables(3).field(2).Name = "patients_with_geparins"
-    tables(3).field(3).Name = "patients_per_quarter"
-    tables(3).field(4).Name = "patients_stationar_nmg"
-    tables(3).field(5).Name = "patients_stationar_clexan"
-    
-    'lpu acs
-    tables(4).Name = "lpu_im"
-    ReDim tables(4).field(1 To 5)
-    
-    tables(4).field(1).Name = "entry_date"
-    tables(4).field(2).Name = "patients_with_geparins"
-    tables(4).field(3).Name = "patients_per_quarter"
-    tables(4).field(4).Name = "patients_stationar_nmg"
-    tables(4).field(5).Name = "patients_stationar_clexan"
-    
-    
-    'lpu acs
-    tables(5).Name = "lpu_ter"
-    ReDim tables(5).field(1 To 9)
-    
-    tables(5).field(1).Name = "entry_date"
-    tables(5).field(2).Name = "patients_per_quarter"
-    tables(5).field(3).Name = "risk_percent"
-    tables(5).field(4).Name = "patients_with_risk_ON"
-    tables(5).field(5).Name = "patients_ambulator"
-    tables(5).field(6).Name = "patients_ambulator_nmg"
-    tables(5).field(7).Name = "patients_ambulator_clexan"
-    tables(5).field(8).Name = "patients_stationar_nmg"
-    tables(5).field(9).Name = "patients_stationar_clexan"
-    
-    
-    
-    Dim tbl_idx As Integer
-    
-    For tbl_idx = 1 To UBound(tables)
-        
-        Dim getSQL As String
-        Dim getRS As Object
-        
-        
-        
-        Set getRS = CreateObject("ADODB.Recordset")
-        
-        getSQL = "SELECT * FROM " & tables(tbl_idx).Name
-        getRS.Open getSQL, from_db
-        
-        If Not getRS.BOF Then
-            Do While Not getRS.EOF
-                Dim insRS As Object
-                Set insRS = CreateObject("ADODB.Recordset")
-                
-                insRS.Open tables(tbl_idx).Name, to_db, 2, 2
-                insRS.addnew
-                Dim fld_idx As Integer
-    
-                    For fld_idx = 1 To UBound(tables(tbl_idx).field)
-                        insRS(tables(tbl_idx).field(fld_idx).Name) = getRS(tables(tbl_idx).field(fld_idx).Name)
-                        insRS("lpu_id") = findNewLPU_IDByOld(objLPU, getRS("lpu_id"))
-                    Next fld_idx
-                    
-                insRS.Update
-                insRS.MoveLast
-                getRS.MoveNext
-            Loop
-        End If
-        
-        
-    Next tbl_idx
-
-End Sub
-
-Function findNewLPU_IDByOld(objLPU() As tLPUCONVERTION, old_id As Long)
-
-Dim i As Integer
-For i = 1 To UBound(objLPU)
-    If objLPU(i).old_lpu_id = old_id Then
-        findNewLPU_IDByOld = objLPU(i).new_lpu_id
-        Exit Function
-    End If
-Next i
-
-findNewLPU_IDByOld = -1
-End Function
-
-
-
-
-
-Sub dbMergeQTR(from_db As Object, to_db As Object, current_rep_id As Long)
-
-    'get all lpu
-    Dim getQTR_SQL As String
-    Dim getRecordset As Object
-    
-    getQTR_SQL = "SELECT * FROM quarter"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getQTR_SQL, from_db
-    
-    If Not getRecordset.BOF Then
-        Do While Not getRecordset.EOF
-            
-            Dim insRS As Object
-            Set insRS = CreateObject("ADODB.Recordset")
-            
-            insRS.Open "quarter", to_db, 2, 2
-            insRS.addnew
-            insRS("rep_id") = current_rep_id
-            insRS("entry_date") = getRecordset("entry_date")
-            insRS("sale_plan") = getRecordset("sale_plan")
-            insRS("ClxnH20mg") = getRecordset("ClxnH20mg")
-            insRS("ClxnH40mg") = getRecordset("ClxnH40mg")
-            insRS("ClxnT40mg") = getRecordset("ClxnT40mg")
-            insRS("ClxnC_IM") = getRecordset("ClxnC_IM")
-            insRS("ClxnC_ACS") = getRecordset("ClxnC_ACS")
-            
-            
-            insRS.Update
-            
-            getRecordset.MoveNext
-        Loop
-    
-    Else
-        MsgBox "There is no information about quarter budget! This database cannot be merged!!!"
-        Exit Sub
-    End If
-End Sub
-
-<<<<<<
-======================
-dbMerge
->>>>>>
-Attribute VB_Name = "dbMerge"
-Option Explicit
-
-Public Type tLPUCONVERTION
-    old_lpu_id As Long
-    new_lpu_id As Long
-End Type
-
-Sub Merge_BackUp_All_Data()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim time_stump As String
-    
-    On Error GoTo ErrHandler
-    
-    time_stump = Format(Date, "yy-mm-dd_") & Format(Time, "hh-mm")
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_BACKUPNAME & time_stump & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ ������ ��������� � �����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������������� ������ � ������ �����", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-    Exit Sub
-    
-ErrHandler:
-    If err.Number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-
-Sub Merge_Clear_All_Data(access_file_full_path As String)
-    
-    Dim db As Object
-    Dim tables_to_clear() As String
-    On Error GoTo ErrHandler
-    
-    ReDim tables_to_clear(1 To 10)
-    tables_to_clear(1) = "rep"
-    tables_to_clear(2) = "lpu"
-    tables_to_clear(3) = "lpu_budget"
-    tables_to_clear(4) = "lpu_hir"
-    tables_to_clear(5) = "lpu_ter"
-    tables_to_clear(6) = "lpu_acs"
-    tables_to_clear(7) = "lpu_im"
-    tables_to_clear(8) = "quarter"
-    tables_to_clear(9) = "quarter_rm"
-    tables_to_clear(10) = "reg_man"
-    
-    Set db = dbGetConnection(access_file_full_path)
-
-    Dim i As Integer
-    
-    For i = 1 To UBound(tables_to_clear)
-        
-        If tables_to_clear(i) <> "" Then
-            Dim Clear_SQL As String
-            Clear_SQL = "DELETE FROM " & tables_to_clear(i)
-            dbExecuteOpenedSQL db, Clear_SQL
-        Else
-            'do nothing or show message
-        End If
-    Next i
-    
-    dbCloseOpenedConnection db
-    Set db = Nothing
-    
-Exit Sub
-
-ErrHandler:
-    MsgBox "something wrong: " & err.Description
-    Resume Next
-    
-End Sub
-
-Function MergeREP(from_file As String, to_file As String) As Long
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    Dim new_rep_id As Long
-
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    MergeREP = dbMergeREP(db1, db2)
-    'MsgBox "new rep ID is " & new_rep_id
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Function
-
-Sub MergeQTR(from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeQTR db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-
-Sub MergeLPU(objLPU() As tLPUCONVERTION, from_file As String, to_file As String, current_rep_id As Long)
-   
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    
-        dbMergeLPU objLPU, db1, db2, current_rep_id
-    
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-    
-End Sub
-
-Sub MergeLPURelated(objLPU() As tLPUCONVERTION, from_file As String, to_file As String)
-    Dim db1 As Object
-    Dim db2 As Object
-    
-    Set db1 = dbGetConnection(from_file)
-    Set db2 = dbGetConnection(to_file)
-    dbMergeLPURelated objLPU, db1, db2
-    dbCloseOpenedConnection db1
-    dbCloseOpenedConnection db2
-
-End Sub
-
-Sub MergeGlobal(rep_files() As String, rm_file As String)
-
-    Dim i As Integer
-    'clear output file content
-    Merge_Clear_All_Data rm_file
-    
-    For i = 1 To UBound(rep_files)
-        
-        Dim rep_file As String
-        'setup input and output files
-        rep_file = rep_files(i)
-        
-        Dim new_rep_id As Long
-        ' insert REP data and get new rep_id
-        new_rep_id = MergeREP(rep_file, rm_file)
-        
-        Dim objLPU() As tLPUCONVERTION
-        'insert all LPU using new generated rep_id
-        'and populate objLPU old->new relation object
-        
-        MergeLPU objLPU, rep_file, rm_file, new_rep_id
-        'insert quarter data using new rep_id
-        MergeQTR rep_file, rm_file, new_rep_id
-        
-        
-        ' and.... insert all another data (5 tables excl version and hw)
-        'using objLPU old->new relation object
-        MergeLPURelated objLPU, rep_file, rm_file
-    
-    
-    Next i
-    
-End Sub
-
-Function GetDBList(MyPath() As String, ByRef dblist() As String) As Integer
-    Dim i As Integer
-    Dim MyName, MyMask
-    MyMask = MyPath(0) & MyPath(1) & PROGRAM_DATAEXT
-    i = 0
-    MyName = Dir(MyMask)      ' Retrieve the first entry.
-    Do While MyName <> ""    ' Start the loop.
-        ' Ignore the current directory and the encompassing directory.
-        If MyName <> "." And MyName <> ".." Then
-            ' Use bitwise comparison to make sure MyName is a directory.
-            i = i + 1
-            ReDim Preserve dblist(i)
-            dblist(i) = MyPath(0) & MyName
-        End If
-        MyName = Dir    ' Get next entry.
-    Loop
-    GetDBList = i
-End Function
-
-<<<<<<
-======================
-cdbPRJ
->>>>>>
-Attribute VB_Name = "cdbPRJ"
-Option Explicit
-
-Type tPROJECT
-    total_SALE  As Long ' ����� ����� ������
-    total_BDGT  As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU   As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_RM    As Long ' ����� �����
-    total_BEDS  As Long ' ����� ����� ����
-    total_HIR   As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER   As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS   As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN   As Long '  ���� ������ ��������
-    objRGN() As tREGION
-End Type
-
-Function GetPRJ_COMM_DATA(ByRef prj_data As tPROJECT) As Integer
-    Dim i As Integer
-    i = GetRGN_COMM_DATA(prj_data.objRGN, 0)
-    GetPRJ_COMM_DATA = i
-    If i > 0 Then
-        With prj_data
-            .sale_PLAN = 0
-            .total_ACS = 0
-            .total_BDGT = 0
-            .total_BDGT_NMG = 0
-            .total_BEDS = 0
-            .total_HIR = 0
-            .total_LPU = 0
-            .total_REP = 0
-            .total_RM = 0
-            .total_SALE = 0
-            .total_TER = 0
-            For i = 1 To UBound(prj_data.objRGN)
-                
-            Next i
-        End With
-    End If
-
-End Function
-
-<<<<<<
-======================
-dbQTR_RM
->>>>>>
-Attribute VB_Name = "dbQTR_RM"
-Option Explicit
-
-Public Type tQTRRM
-    id As Long
-    entry_date As String
-    rm_id As Long
-    sale_PLAN As Long
-End Type
-
-
-Sub Insert_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTRRM.id <> 0 Then
-        dbUpdate_QTRRM_Record dbConnection, objQTRRM
-    Else
-        dbInsert_QTRRM_Record dbConnection, objQTRRM
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTRRM_Record(ent_date As String) As tQTRRM
-    Dim dbConnection As Object
-    Dim allQTRRM() As tQTRRM
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTRRM_Records(dbConnection, allQTRRM, ent_date)
-    If i <> 0 Then
-        Get_QTRRM_Record = allQTRRM(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTRRM_Records(ByRef all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTRRM_Records = dbGetAll_QTRRM_Records(dbConnection, all_QTRRM, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTRRM_Record(ByRef objQTRRM As tQTRRM)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTRRM_Record dbConnection, objQTRRM
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTRRM.ID <> 0 then updatre else insert
-Sub dbInsert_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter_rm", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTRRM
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_PLAN
-        dbRecordset("rm_id") = .rm_id
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTRRM.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    Dim Update_SQL As String
-    
-    With objQTRRM
-        Update_SQL = "UPDATE quarter_rm SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rm_id=" & .rm_id & "," & _
-            "sale_plan=" & .sale_PLAN & "," & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTRRM_Records(dbConnection As Object, all_QTRRM() As tQTRRM, ent_date As String) As Integer
-    
-    Dim getCount_QTRRM_SQL As String
-    Dim getAll_QTRRM_SQL As String
-    Dim QTRRM_Count As Long
-    QTRRM_Count = 0
-    
-    getCount_QTRRM_SQL = "SELECT COUNT(*) AS QTRRM_TOTAL FROM quarter_rm WHERE entry_date like '" & ent_date & "'"
-    getAll_QTRRM_SQL = "SELECT * FROM quarter_rm WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTRRM_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTRRM_Count = dbRecordset("QTRRM_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTRRM_Records = QTRRM_Count
-    
-    If QTRRM_Count > 0 Then
-        'we have records
-        ReDim all_QTRRM(1 To QTRRM_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTRRM_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTRRM As tQTRRM
-                 With tmp_QTRRM
-                    .entry_date = dbRecordset("entry_date")
-                    .rm_id = dbRecordset("rep_id")
-                    .sale_PLAN = dbRecordset("sale_plan")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 all_QTRRM(index) = tmp_QTRRM
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTRRM_Record(dbConnection As Object, ByRef objQTRRM As tQTRRM)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter_rm " & _
-    "WHERE id=" & objQTRRM.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    MsgBox "remember delete related"
-'    dbDelete_BDGT_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Hir_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_Ter_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-'    dbDelete_ACS_RecordsByQTRRM dbConnection, objQTRRM.entry_date
-       
-End Sub
-
-
-<<<<<<
-======================
-REP_LIST
->>>>>>
-Attribute VB_Name = "REP_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentREP_ID() As Long
-    Dim r As Range
-
-    With Worksheets("REP_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CREP_ID)
-    End With
-
-    getCurrentREP_ID = r
-End Function
-
-Public Sub REP_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Rep_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rep_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rep_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-        
-        Case 4
-            Rep_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "REP_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectREP_LPU(rep_id As Long, ent_date As String)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "LPU_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-        .Range("RM_ID") = rm_id
-        .setEnt_date (getEnt_date())
-    End With
-End Sub
-
-Public Sub SelectREP_QTR(rep_id As Long)
-    Dim vo As Boolean
-    Dim rm_id As Long
-    
-    rm_id = Range("RM_ID")
-    
-    Range("JUMP") = "REP_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("RM_ID") = rm_id
-        .Range("ret_addr") = "REP_LIST"
-        .Range("REP_ID") = rep_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateREPList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CREP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CREP_AREA).row, CREP_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CREP_AREA).Column
-    
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-    
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CREP_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CREP_NAME
-        Range("JUMP") = ""
-    Else
-        btREP_LIST_DO_IT
-    End If
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateREPList()
-    Dim rcd() As tREPID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    Dim rm_struc As tREGMAN
-    
-    i = Range("RM_ID")
-    rm_struc = Get_REGMAN_Record(i)
-    
-    Range("C4") = rm_struc.LastName
-    Range("C5") = rm_struc.FirstName
-
-    Range("G5") = GetRegionName(rm_struc.Region)
-    
-    i = Get_REP_CommonList_by_QTR(rcd, ent_date, Range("RM_ID"))
-
-    
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rcd)
-            r.Offset(i - 1, CREP_NAME) = rcd(i).rep.FirstName & " " & rcd(i).rep.LastName
-            r.Offset(i - 1, CREP_ID) = rcd(i).rep.rep_id
-            r.Offset(i - 1, CREP_BEDS) = rcd(i).qtrs(1).c_beds
-
-            r.Offset(i - 1, CREP_NFG) = rcd(i).qtrs(1).c_bdgt_NFG
-            r.Offset(i - 1, CREP_NMG) = rcd(i).qtrs(1).c_bdgt_NMG
-
-            r.Offset(i - 1, CREP_PLAN) = rcd(i).qtrs(1).qtr.sale_PLAN
-
-            r.Offset(i - 1, CREP_HIR) = rcd(i).qtrs(1).c_pat_HIR
-            r.Offset(i - 1, CREP_TER) = rcd(i).qtrs(1).c_pat_TER
-            r.Offset(i - 1, CREP_CAR) = rcd(i).qtrs(1).c_pat_CRD
-            r.Offset(i - 1, CREP_FACT) = rcd(i).qtrs(1).c_sale_ALL
-            r.Offset(i - 1, CREP_PAT_LPU) = rcd(i).qtrs(1).c_pat_LPU
-            r.Offset(i - 1, CREP_BDGT) = rcd(i).qtrs(1).c_bdgt_LPU
-            If rcd(i).qtrs(1).c_bdgt_LPU > 0 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = rcd(i).qtrs(1).c_sale_ALL / rcd(i).qtrs(1).c_bdgt_LPU
-            End If
-            If r.Offset(i - 1, CREP_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CREP_BDGT + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-<<<<<<
-======================
-mREP_LIST
->>>>>>
-Attribute VB_Name = "mREP_LIST"
-Option Explicit
-
-Public Const CREP_AREA As String = "B12"
-Public Const CREP_NAME As Integer = 0
-Public Const CREP_NAME1 As Integer = 1
-Public Const CREP_NAME2 As Integer = 2
-Public Const CREP_ID As Integer = 3
-Public Const CREP_BEDS As Integer = 4
-Public Const CREP_NFG As Integer = 5
-Public Const CREP_NMG As Integer = 6
-Public Const CREP_HIR As Integer = 7
-Public Const CREP_TER As Integer = 8
-Public Const CREP_CAR As Integer = 9
-Public Const CREP_FACT As Integer = 10
-Public Const CREP_PLAN As Integer = 11
-Public Const CREP_PAT_LPU As Integer = 16
-Public Const CREP_BDGT As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(cRep As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("REP_LIST")
-        s = .Range("C5") & " " & .Range("C4") & ", " & .Range("G5") & ", " & .getEnt_date()
-    End With
-    MakeChartTitle = s
-End Function
-
-Sub Rep_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-End Sub
-
-Sub Rep_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rep_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("REP_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CREP_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CREP_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CREP_HIR + 1)
-            psum = psum + src.Cells(i, CREP_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CREP_TER + 1)
-            psum = psum + src.Cells(i, CREP_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CREP_CAR + 1)
-            psum = psum + src.Cells(i, CREP_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CREP_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub btREP_RET_IT()
-    With Worksheets("REP_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "RM_QTR"
-    End With
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-
-Sub btREP_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rep_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("REP_LST_DETALS")
-    With Worksheets("REP_LIST")
-        rep_id = .getCurrentREP_ID
-        
-        Select Case i
-            Case 1:
-                .SelectREP_QTR rep_id
-            Case 2:
-                ent_date = .getEnt_date()
-                .SelectREP_LPU rep_id, ent_date
-        End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-<<<<<<
-======================
-cdbREP
->>>>>>
-Attribute VB_Name = "cdbREP"
-Option Explicit
-
-Public Type tREPID_COMMON
-    rep As tREPID
-    i_qtrs As Integer
-    qtrs() As tQTR_COMMON
-End Type
-
-Function Get_REP_CommonList_by_QTR(ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_REP_CommonList_by_QTR = dbGet_REP_CommonList_by_QTR(dbConnection, rcd, ent_date, rm_id)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_REP_CommonList_by_QTR(dbConnection As Object, ByRef rcd() As tREPID_COMMON, ent_date As String, rm_id As Long) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim k As Long
-    Dim allREPID() As tREPID
-    
-    i = dbGetAll_REPID_Records_by_QTR(dbConnection, allREPID, ent_date, rm_id)
-    dbGet_REP_CommonList_by_QTR = i
-    If i > 0 Then
-        ReDim rcd(i)
-        For i = 1 To UBound(allREPID)
-            rcd(i).rep = allREPID(i)
-            rcd(i).i_qtrs = Get_QTR_CommonList_by_REP(rcd(i).qtrs, ent_date, allREPID(i).rep_id, allREPID(i).rm_id)
-        Next i
-    End If
-End Function
-
-
-
-<<<<<<
-======================
-CHRT_PAT_LPU_A
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU_A"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Sub PrintCopy()
-    ChartObjects(1).CopyPicture xlScreen, xlBitmap
-End Sub
-
-Private Sub Worksheet_Activate()
-    On Error Resume Next
-    ChartObjects(1).Chart.ChartTitle.Characters.Text = "�������� �� ��������(���.): " & Range("title")
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Range("title") = CHART_DEF_TITLE
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-cdbRegion
->>>>>>
-Attribute VB_Name = "cdbRegion"
-Option Explicit
-
-Type tREGION
-    ent_date As String
-    rm_id As Long
-    total_SALE As Long ' ����� ����� ������
-    total_BDGT As Long ' ������ ���� ���
-    total_BDGT_NMG As Long ' ������ ���� ��� �� ���
-    total_LPU As Long ' ����� ���
-    total_REP   As Long ' ����� �����
-    total_BEDS As Long ' ����� ����� ����
-    total_HIR As Long '  ����� ����� ��������� �� �������� � ��������
-    total_TER As Long '  ����� ����� ��������� �� �������� � �������
-    total_ACS As Long '  ����� ����� ��������� �� �������� � �����������
-    sale_PLAN As Long '  ���� ������ ��������
-End Type
-
-Function GetRGN_COMM_DATA(ByRef reg_data() As tREGION, rm_id As Long) As Integer
-    Dim q_date() As String
-    Dim q_count As Integer, i As Integer
-    
-    q_count = getAllQTRNames(q_date, rm_id)
-    If q_count > 0 Then
-        ReDim reg_data(q_count)
-        For i = 1 To q_count
-            Dim current_REP_count As Integer
-            reg_data(i).rm_id = rm_id
-            reg_data(i).ent_date = q_date(i)
-            current_REP_count = getREGION_by_QTR(q_date(i), reg_data(i), rm_id)
-        Next i
-    End If
-    
-    GetRGN_COMM_DATA = q_count
-End Function
-
-' if rm_id = 0 then gets all records
-Function getAllQTRNames(ByRef qtr_lst() As String, rm_id As Long) As Integer
-    
-    Dim sql As String
-    Dim i As Integer
-    Dim db As Object, rs As Object
-    
-    sql = "SELECT DISTINCT entry_date FROM lpu_budget"
-    
-    If rm_id <> 0 Then
-        sql = sql & " WHERE rm_id=" & rm_id
-    End If
-    
-    i = 0
-    
-    dbOpenConnection db
-    Set rs = CreateObject("ADODB.Recordset")
-    
-    rs.Open sql, db
-        
-        If Not rs.BOF Then
-            Do While Not rs.EOF
-                i = i + 1
-                ReDim Preserve qtr_lst(i)
-                qtr_lst(i) = rs("entry_date")
-                rs.MoveNext
-            Loop
-        Else
-            getAllQTRNames = 0
-            Exit Function
-        End If
-    getAllQTRNames = i
-    dbCloseConnection db
-End Function
-
-Function getREGION_by_QTR(ent_date As String, treg As tREGION, rm_id As Long) As Integer
-    Dim rep_count As Integer
-    rep_count = 0
-    
-    Dim reps() As tQTR_COMMON
-    rep_count = Get_QTR_CommonList_by_REP(reps, ent_date, 0, rm_id)
-    
-    treg.ent_date = ent_date
-    treg.total_BDGT = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.total_BDGT_NMG = 0 ' lpu_budget.bdgt_NMG+lpu_budget.bdgt_NFG
-    treg.sale_PLAN = 0 ' quarter.sale_plan
-    treg.total_SALE = 0 'summ of
-    ' hir = (amb40+st40)*pr40 + (amb20+st20)*pr20
-    'ter (amb_clx+stat_clx)*price
-    ' acs xxx
-    'price per rep
-    treg.total_HIR = 0 'patiens clxn
-    treg.total_TER = 0 'patiens clxn
-    treg.total_ACS = 0 'patiens clxn
-    treg.total_LPU = 0 'lpu
-    treg.total_BEDS = 0 'lpu.beds
-    treg.total_REP = 0 '
-    
-    If rep_count > 0 Then
-        Dim i As Integer
-        
-        For i = 1 To UBound(reps)
-            ' current rep is reps(i)
-            With reps(i)
-                treg.total_BDGT = treg.total_BDGT + .c_bdgt_NFG + .c_bdgt_NMG
-                treg.total_BDGT_NMG = treg.total_BDGT_NMG + .c_bdgt_NMG
-                treg.sale_PLAN = treg.sale_PLAN + .qtr.sale_PLAN
-                treg.total_SALE = treg.total_SALE + .c_sale_ALL
-                treg.total_HIR = treg.total_HIR + .c_pat_HIR
-                treg.total_TER = treg.total_TER + .c_pat_TER
-                treg.total_ACS = treg.total_ACS + .c_pat_CRD
-                treg.total_LPU = treg.total_LPU + .i_lcd
-                treg.total_BEDS = treg.total_BEDS + .c_beds
-                treg.total_REP = treg.total_REP + 1
-            End With
-            
-        Next i
-        
-    End If
-    
-    getREGION_by_QTR = treg.total_REP
-End Function
-
-<<<<<<
-======================
-mRM_QTR
->>>>>>
-Attribute VB_Name = "mRM_QTR"
-Option Explicit
-
-Sub btRM_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    Dim i As Integer
-    Dim def_dir As String
-    Dim flist() As String
-    
-    idx = Worksheets(VAR_SHEET).Range("RM_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-'            def_dir = GetWBPath(ThisWorkbook.FullName)
-'            If GetImportDirectory(def_dir, flist) Then
-'                Dim db_list() As String
-'                i = GetDBList(flist, db_list)
-'                If i > 0 Then
-'                    ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-'                End If
-'            End If
-'            Worksheets(RM_QTR_SHEET).update_history
-        Case 2
-            Worksheets("REP_LIST").Range("ret_addr") = "RM_QTR"
-            Worksheets("REP_LIST").setEnt_date (Worksheets(RM_QTR_SHEET).getEnt_date())
-            Worksheets("REP_LIST").Range("RM_ID") = Worksheets(RM_QTR_SHEET).Range("RM_ID")
-            Worksheets("REP_LIST").Range("VIEW_ONLY") = True
-
-            Worksheets("REP_LIST").Select
-        Case 3
-            MsgBox "������� �� ��������", vbOKOnly, PROGRAM_NAME
-    End Select
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-End Sub
-
-Sub btRM_QTR_RET_IT()
-    Dim str As String
-    str = Range("ret_addr")
-    ThisWorkbook.Worksheets(str).Activate
-End Sub
-
-<<<<<<
-======================
-mImport
->>>>>>
-Attribute VB_Name = "mImport"
-    Option Explicit
-
-Const OFN_ALLOWMULTISELECT As Long = 512
-Const OFN_EXPLORER As Long = 524288
-Const OFN_HIDEREADONLY As Long = 4
-Const OFN_NONETWORKBUTTON As Long = 131072
-Const OFN_READONLY As Long = 1
-       
-Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
-    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
-
-Private Type OPENFILENAME
-    lStructSize As Long
-    hWndOwner As Long
-    hInstance As Long
-    lpstrFilter As String
-    lpstrCustomFilter As String
-    nMaxCustFilter As Long
-    nFilterIndex As Long
-    lpstrFile As String
-    nMaxFile As Long
-    lpstrFileTitle As String
-    nMaxFileTitle As Long
-    lpstrInitialDir As String
-    lpstrTitle As String
-    flags As Long
-    nFileOffset As Integer
-    nFileExtension As Integer
-    lpstrDefExt As String
-    lCustData As Long
-    lpfnHook As Long
-    lpTemplateName As String
-End Type
-
-Function GetImportDirectory(DB_dir As String, flist() As String) As Boolean
-    Dim OpenFile As OPENFILENAME
-    Dim lReturn As Long
-    Dim sFilter As String
-    
-    OpenFile.lStructSize = Len(OpenFile)
-    '         OpenFile.hwndOwner = Form1.hWnd
-    '         OpenFile.hInstance = App.hInstance
-    sFilter = "Clexane Data Files" & Chr(0) & PROGRAM_IMPORTNAME & PROGRAM_DATAEXT & Chr(0)
-    OpenFile.lpstrFilter = sFilter
-    OpenFile.nFilterIndex = 1
-    OpenFile.lpstrFile = String(257, 0)
-    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
-    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
-    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
-    OpenFile.lpstrInitialDir = DB_dir
-    OpenFile.lpstrTitle = "������ ������"
-    OpenFile.flags = OFN_HIDEREADONLY + OFN_EXPLORER
-    lReturn = GetOpenFileName(OpenFile)
-    If lReturn = 0 Then
-        GetImportDirectory = False
-    Else
-        GetImportDirectory = True
- 
-        flist = Split(OpenFile.lpstrFile, Chr(0), Compare:=vbBinaryCompare)
-        Dim i As Integer
-        i = 0
-        Do While flist(i) <> ""
-            i = i + 1
-        Loop
-        If i = 1 Then
-            flist(1) = flist(0)
-            flist(0) = GetWBPath(flist(1))
-            flist(1) = GetWBName(flist(1))
-        Else
-            flist(0) = flist(0) & "\"
-        End If
-    End If
-End Function
-<<<<<<
-======================
-cPPReport
->>>>>>
-Attribute VB_Name = "cPPReport"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Const PPR_NON As Integer = 0
-Const PPR_NEW As Integer = 1
-Const PPR_OLD As Integer = 2
-
-Dim ReportApp As PowerPoint.Application
-Dim ReportDoc As PowerPoint.Presentation
-Dim ReportState As Integer
-Dim PowerPointPath As String
-
-Private Sub Class_Initialize()
-    Set ReportApp = CreateObject("PowerPoint.Application")
-    PowerPointPath = ReportApp.Path & "\PowerPNT.EXE"
-    ReportState = PPR_NON
-End Sub
-
-Sub OpenReport(FileName As String)
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = GetObject(FileName)
-    ReportState = PPR_OLD
-End Sub
-
-Sub CreateReport()
-    If ReportState <> PPR_NON Then
-        SaveReport
-    End If
-    Set ReportDoc = ReportApp.Presentations.Add
-    ReportState = PPR_NEW
-End Sub
-
-Sub SaveReport()
-    Select Case ReportState
-        Case PPR_NEW
-            ReportDoc.SaveAs GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME
-        Case PPR_OLD
-            ReportDoc.Save
-    End Select
-    ReportState = PPR_NON
-End Sub
-
-Sub ReportView()
-    Dim CmdName As String
-    CmdName = GetWBPath(ThisWorkbook.FullName) + PROGRAM_FILENAME + ".PPT"
-    CmdName = PowerPointPath & " " & CmdName
-    Shell CmdName, 1
-End Sub
-
-Sub InsertSlide()
-    Dim ReportPage As PowerPoint.Slide
-    Set ReportPage = ReportDoc.Slides.Add(ReportDoc.Slides.count + 1, ppLayoutBlank)
-    
-    ReportPage.Shapes.Paste
-    ReportPage.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 20, 640, 40) _
-      .TextFrame.TextRange.Text = "Slide #" & Format(ReportDoc.Slides.count)
-End Sub
-
-
-Private Sub Class_Terminate()
-    SaveReport
-    ReportApp.Quit
-End Sub
-<<<<<<
-======================
-dlgImprtDB
->>>>>>
-Attribute VB_Name = "dlgImprtDB"
-Attribute VB_Base = "0{36355920-F7A4-44A8-96EF-5D79CF26137D}{F852BDF2-AB3E-468E-89DF-EC5DC0C7C88B}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-
-Private Sub btSelAll_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = True
-    Next i
-End Sub
-
-Private Sub btUnselect_Click()
-    For i = 0 To Me.lbListDB.ListCount - 1
-        Me.lbListDB.Selected(i) = False
-    Next i
-End Sub
-<<<<<<
-======================
-rmImport
->>>>>>
-Attribute VB_Name = "rmImport"
-Option Explicit
-
-Public Type dbDESCRIPTION
-    Name As String
-    Fields() As String
-End Type
-
-Sub ImportFromRegionalManagers(rm_files() As String, fm_file As String)
-    Dim db(9) As dbDESCRIPTION
-    
-    '''''data
-    db(1).Name = "rep"
-    
-    db(2).Name = "lpu"
-    db(3).Name = "lpu_acs"
-    db(4).Name = "lpu_budget"
-    db(5).Name = "lpu_hir"
-    db(6).Name = "lpu_im"
-    db(7).Name = "lpu_ter"
-    db(8).Name = "quarter"
-    db(9).Name = "quarter_rm"
-    
-    ReDim db(1).Fields(5)
-    With db(1)
-        .Fields(1) = "rep_id"
-        .Fields(2) = "firstname"
-        .Fields(3) = "lastname"
-        .Fields(4) = "region"
-        .Fields(5) = "city"
-    End With
-    
-    ReDim db(2).Fields(5)
-    With db(2)
-        .Fields(1) = "id"
-        .Fields(2) = "rep_id"
-        .Fields(3) = "name"
-        .Fields(4) = "address"
-        .Fields(5) = "beds"
-    End With
-    
-    ReDim db(3).Fields(7)
-    With db(3)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(4).Fields(6)
-    With db(4)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "bdgt_NMG"
-        .Fields(5) = "bdgt_NFG"
-        .Fields(6) = "sale_PLAN"
-    End With
-    
-    ReDim db(5).Fields(15)
-    With db(5)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "operations_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_ambulator_clexan_40mg"
-        .Fields(11) = "patients_ambulator_clexan_20mg"
-        .Fields(12) = "patients_stationar_nmg"
-        .Fields(13) = "patients_stationar_clexan"
-        .Fields(14) = "patients_stationar_clexan_40mg"
-        .Fields(15) = "patients_stationar_clexan_20mg"
-    End With
-    
-    
-    ReDim db(6).Fields(7)
-    With db(6)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_with_geparins"
-        .Fields(5) = "patients_per_quarter"
-        .Fields(6) = "patients_stationar_nmg"
-        .Fields(7) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(7).Fields(11)
-    With db(7)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "lpu_id"
-        .Fields(4) = "patients_per_quarter"
-        .Fields(5) = "risk_percent"
-        .Fields(6) = "patients_with_risk_ON"
-        .Fields(7) = "patients_ambulator"
-        .Fields(8) = "patients_ambulator_nmg"
-        .Fields(9) = "patients_ambulator_clexan"
-        .Fields(10) = "patients_stationar_nmg"
-        .Fields(11) = "patients_stationar_clexan"
-    End With
-    
-    ReDim db(8).Fields(9)
-    With db(8)
-        .Fields(1) = "ID"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "rep_id"
-        .Fields(4) = "sale_plan"
-        .Fields(5) = "ClxnH20mg"
-        .Fields(6) = "ClxnH40mg"
-        .Fields(7) = "ClxnT40mg"
-        .Fields(8) = "ClxnC_IM"
-        .Fields(9) = "ClxnC_ACS"
-    End With
-    
-    ReDim db(9).Fields(3)
-    With db(9)
-        .Fields(1) = "id"
-        .Fields(2) = "entry_date"
-        .Fields(3) = "sale_plan"
-    End With
-    
-    Dim rm_idx As Integer
-    Dim to_db As Object
-    'back uo
-    Merge_BackUp_All_Data
-    
-    'clean up
-    Merge_Clear_All_Data fm_file
-    
-    Set to_db = dbGetConnection(fm_file)
-    
-    For rm_idx = 1 To UBound(rm_files)
-        Dim from_db As Object
-        
-        Set from_db = dbGetConnection(rm_files(rm_idx))
-        
-        Dim new_rm_id As Long
-        new_rm_id = dbMergeRM(from_db, to_db)
-
-        Dim i As Integer
-
-        For i = 1 To UBound(db)
-            Dim get_sql As String
-            Dim getRS As Object
-            Dim insRS As Object
-            Dim field_idx As Integer
-                        
-            get_sql = "SELECT * FROM " & db(i).Name
-            Set getRS = CreateObject("ADODB.Recordset")
-            Set insRS = CreateObject("ADODB.Recordset")
-            insRS.Open db(i).Name, to_db, 2, 2
-
-            getRS.Open get_sql, from_db
-            
-            If Not getRS.BOF Then
-                Do While Not getRS.EOF
-                    insRS.addnew
-                    Dim fld_name As String
-                    
-                    For field_idx = 1 To UBound(db(i).Fields)
-                        fld_name = db(i).Fields(field_idx)
-                        insRS(fld_name) = getRS(fld_name)
-                    Next field_idx
-                    
-                    insRS("rm_id") = new_rm_id
-                    insRS.Update
-                    getRS.MoveNext
-                Loop
-            
-            Else
-                'empty table
-                ' do nothing
-            End If
-            
-            
-        Next i
-        
-        dbCloseOpenedConnection from_db
-    Next rm_idx
-    
-    dbCloseOpenedConnection to_db
-End Sub
-
-Function dbMergeRM(from_dbConnection As Object, to_dbConnection As Object) As Long
-
-    Dim getRecordset As Object
-    Dim getREPData_SQL As String
-    Dim REP_fn As String
-    Dim REP_ln As String
-    Dim REP_region As String
-    Dim REP_city As String
-
-
-    getREPData_SQL = "SELECT * FROM reg_man"
-    Set getRecordset = CreateObject("ADODB.Recordset")
-    
-    getRecordset.Open getREPData_SQL, from_dbConnection
-        
-        If Not getRecordset.BOF Then
-            REP_fn = getRecordset("firstname")
-            REP_ln = getRecordset("lastname")
-            REP_city = getRecordset("city")
-            REP_region = getRecordset("region")
-        Else
-            MsgBox "There is no information about Regional Manager! This database cannot be merged!!!"
-            dbMergeRM = -1
-            Exit Function
-        End If
-    
-    Dim insertRecordset As Object
-    Set insertRecordset = CreateObject("ADODB.Recordset")
-        
-    insertRecordset.Open "reg_man", to_dbConnection, 2, 2
-    insertRecordset.addnew
-        
-    insertRecordset("firstname") = REP_fn
-    insertRecordset("lastname") = REP_ln
-    insertRecordset("region") = REP_region
-    insertRecordset("city") = REP_city
-    insertRecordset.Update
-    insertRecordset.MoveLast
-    'new ID
-    dbMergeRM = insertRecordset("mgr_id")
-    
-End Function
-
-Sub cmDataImport()
-    Dim def_dir As String
-    Dim flist() As String
-    Dim i As Integer
-
-    def_dir = GetWBPath(ThisWorkbook.FullName)
-    If GetImportDirectory(def_dir, flist) Then
-        Dim ImpMask() As String
-        ImpMask = Split(flist(1), Chr(95), Compare:=vbBinaryCompare)
-        flist(1) = ImpMask(0) & "*"
-        Dim db_list() As String
-        i = GetDBList(flist(), db_list)
-        
-        If i > 0 Then
-            ImportFromRegionalManagers db_list, GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-        End If
-    End If
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(PRJ_QTR_SHEET).Select
-End Sub
-
-
-<<<<<<
-======================
-PRJ_QTR
->>>>>>
-Attribute VB_Name = "PRJ_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CPRJ_QT As Integer = 0
-Const CPRJ_ID As Integer = 1
-Const CPRJ_PLN As Integer = 2
-Const CPRJ_FCT As Integer = 3
-Const CPRJ_BDG As Integer = 4
-Const CPRJ_CNT As Integer = 5
-Const CPRJ_BEDS As Integer = 6
-Const CPRJ_HIR As Integer = 7
-Const CPRJ_TER As Integer = 8
-Const CPRJ_CRD As Integer = 9
-Const CPRJ_CLXN_BDG As Integer = 10
-Const CPRJ_CLXN_NMG As Integer = 11
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Const LOCAL_ENT_DATE As String = "B11"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("PRJ_QTR")
-        s = "��� �������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub update_history()
-    Dim objQTR() As tREGION
-    Dim i As Long
-    Dim r As Range
-
-
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    
-    i = GetRGN_COMM_DATA(objQTR(), 0)
-    
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CPRJ_QT) = objQTR(i).ent_date
-            r.Offset(i - 1, CPRJ_ID) = ""
-            r.Offset(i - 1, CPRJ_PLN) = objQTR(i).sale_PLAN
-            r.Offset(i - 1, CPRJ_FCT) = objQTR(i).total_SALE
-            r.Offset(i - 1, CPRJ_BDG) = objQTR(i).total_BDGT
-            r.Offset(i - 1, CPRJ_CNT) = objQTR(i).total_LPU
-            r.Offset(i - 1, CPRJ_BEDS) = objQTR(i).total_REP
-            r.Offset(i - 1, CPRJ_HIR) = objQTR(i).total_HIR
-            r.Offset(i - 1, CPRJ_TER) = objQTR(i).total_TER
-            r.Offset(i - 1, CPRJ_CRD) = objQTR(i).total_ACS
-            If objQTR(i).total_BDGT <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_BDG) = objQTR(i).total_SALE / objQTR(i).total_BDGT
-            End If
-            If objQTR(i).total_BDGT_NMG <> 0 Then
-                r.Offset(i - 1, CPRJ_CLXN_NMG) = objQTR(i).total_SALE / objQTR(i).total_BDGT_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_PAT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CPRJ_CRD + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-
-Sub Draw_PLN_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_FCT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PLN_QTR").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Draw_BDGT_QTR_PRJ()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets(PRJ_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CPRJ_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CPRJ_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CPRJ_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CPRJ_CLXN_NMG + 1)
-        End If
-    Next i
-    Worksheets("CHRT_BDGT_QTR").Range("title") = MakeChartTitle
-End Sub
-
-Public Sub cbxPRJ_QtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR_PRJ
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR_PRJ
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR_PRJ
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = PRJ_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-Private Sub Worksheet_Activate()
-
-    Protect UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("RM_ACTION") = 2
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CRow_Width Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CPRJ_QT + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    If r = "" Then
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-        Range("LAST_FOCUS") = currRange.address
-        With Worksheets("REP_LIST")
-            .Range("ret_addr") = "PRJ_QTR"
-            .Range("ent_date") = r
-            .Range("VIEW_ONLY") = True
-        End With
-    End If
-    Cancel = True
-    btPRJ_QTR_Do_IT ' old btRM_OTR_DO_IT
-End Sub
-
-<<<<<<
-======================
-RM_LIST
->>>>>>
-Attribute VB_Name = "RM_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Const LOCAL_ENT_DATE As String = "C10"
-
-Sub PrintCopy()
-    Range("A1:N33").CopyPicture xlScreen, xlBitmap
-End Sub
-
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-
-Public Function getCurrentRM_ID() As Long
-    Dim r As Range
-
-    With Worksheets("RM_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CRM_ID)
-    End With
-
-    getCurrentRM_ID = r
-End Function
-
-Public Sub RM_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("PM_CHR_IDX")
-        Case 1
-            Rm_Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Rm_Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Rm_Draw_PAT_LPU_A
-            With Worksheets("CHRT_PAT_LPU_A")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU_A"
-
-        Case 4
-            Rm_Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "RM_LIST"
-            End With
-
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectRM_QTR(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "RM_QTR"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("RM_QTR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Public Sub SelectREP_LIST(rm_id As Long)
-    Dim vo As Boolean
-
-    Range("JUMP") = "REP_LIST"
-
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("REP_LIST")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "RM_LIST"
-        .setEnt_date (getEnt_date())
-        .Range("RM_ID") = rm_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateRMList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Sub UpdateRMList()
-    Dim rmcd() As tRMID_COMMON
-
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-
-    ent_date = getEnt_date
-
-    i = Get_RM_CommonList_by_QTR(rmcd(), ent_date)
-
-    With ThisWorkbook.Worksheets("RM_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-
-        For i = 1 To UBound(rmcd)
-            r.Offset(i - 1, CRM_NAME) = GetRegionName(rmcd(i).rm.Region)
-            r.Offset(i - 1, CRM_ID) = rmcd(i).rm.rm_id
-            r.Offset(i - 1, CRM_BEDS) = rmcd(i).rgcd(1).total_BEDS
-            r.Offset(i - 1, CRM_BDGT) = rmcd(i).rgcd(1).total_BDGT
-            r.Offset(i - 1, CRM_NMG) = rmcd(i).rgcd(1).total_BDGT_NMG
-            r.Offset(i - 1, CRM_HIR) = rmcd(i).rgcd(1).total_HIR
-            r.Offset(i - 1, CRM_TER) = rmcd(i).rgcd(1).total_TER
-            r.Offset(i - 1, CRM_CAR) = rmcd(i).rgcd(1).total_ACS
-            r.Offset(i - 1, CRM_FACT) = rmcd(i).rgcd(1).total_SALE
-            r.Offset(i - 1, CRM_PLAN) = rmcd(i).rgcd(1).sale_PLAN
-            
-            With rmcd(i).rgcd(1)
-                r.Offset(i - 1, CRM_PAT_LPU) = .total_HIR + .total_TER + .total_ACS
-            End With
-            
-            r.Offset(i - 1, CRM_BDGT_1) = rmcd(i).rgcd(1).total_BDGT
-            If rmcd(i).rgcd(1).total_BDGT > 0 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = rmcd(i).rgcd(1).total_SALE / rmcd(i).rgcd(1).total_BDGT
-            End If
-            If r.Offset(i - 1, CRM_BDGT_1 + 1) > 1 Then
-                r.Offset(i - 1, CRM_BDGT_1 + 1) = 1
-            End If
-
-        Next i
-    End If
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.count > 1 And r_sel.Columns.count < CINP_WIDTH Or r_sel.Rows.count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim rep_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    ent_date = getEnt_date
-
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    Set r = Range(CRM_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CRM_AREA).row, CRM_ID)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    rep_id = r
-
-    i = Range(Range("LAST_FOCUS")).Column - Range(CRM_AREA).Column
-
-    If i < 4 Then
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 1
-    Else
-        Worksheets(VAR_SHEET).Range("REP_LST_DETALS").Value = 2
-    End If
-
-    If rep_id = 0 Then
-        Range("LAST_FOCUS") = Range(CRM_AREA).address
-    End If
-
-    If rep_id = 0 Then
-        i = CRM_NAME
-        Range("JUMP") = ""
-    Else
-        btRM_LIST_DO_IT
-    End If
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-<<<<<<
-======================
-mPRJ_QTR
->>>>>>
-Attribute VB_Name = "mPRJ_QTR"
-Sub btPRJ_QTR_Do_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    
-    idx = Worksheets(VAR_SHEET).Range("PRJ_ACTION")
-    ent_date = Worksheets(PRJ_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            cmDataImport
-        Case 2
-            Worksheets("RM_LIST").setEnt_date (Worksheets("PRJ_QTR").getEnt_date())
-            Worksheets("RM_LIST").Range("ret_addr") = "PRJ_QTR"
-            Worksheets("RM_LIST").Select
-        Case 3
-            cmNewReport
-    End Select
-    Worksheets(VAR_SHEET).Range("PRJ_ACTION") = 2
-End Sub
-
-
-<<<<<<
-======================
-mRM_LIST
->>>>>>
-Attribute VB_Name = "mRM_LIST"
-Option Explicit
-
-Public Const CRM_AREA As String = "B12"
-Public Const CRM_NAME As Integer = 0
-Public Const CRM_NAME1 As Integer = 1
-Public Const CRM_NAME2 As Integer = 2
-Public Const CRM_ID As Integer = 3
-Public Const CRM_BEDS As Integer = 4
-Public Const CRM_BDGT As Integer = 5
-Public Const CRM_NMG As Integer = 6
-Public Const CRM_HIR As Integer = 7
-Public Const CRM_TER As Integer = 8
-Public Const CRM_CAR As Integer = 9
-Public Const CRM_FACT As Integer = 10
-Public Const CRM_PLAN As Integer = 11
-Public Const CRM_PAT_LPU As Integer = 16
-Public Const CRM_BDGT_1 As Integer = 17
-
-
-Const LOCAL_ENT_DATE As String = "C10"
-Public Function getEnt_date() As String
-    getEnt_date = Range(LOCAL_ENT_DATE)
-End Function
-
-Public Function setEnt_date(ent_date As String) As String
-    Range(LOCAL_ENT_DATE) = ent_date
-End Function
-
-Sub EditREP(CRM As tREPID, ent_date As String)
-    NoFunc
-End Sub
-
-Function MakeChartTitle() As String
-    Dim s As String
-    With Worksheets("RM_LIST")
-        s = "�������, " & .getEnt_date()
-    End With
-    
-    MakeChartTitle = s
-End Function
-
-Sub Rm_Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_LPU_BBL").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_FACT + 1)
-        End If
-    Next i
-    
-    Worksheets("CHRT_PIE").Range("title") = MakeChartTitle
-
-End Sub
-
-Sub Rm_Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub Rm_Draw_PAT_LPU_A()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("RM_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU_A").Range("CHRT_PAT_LPU_DATA")
-
-    dst.ClearContents
-
-    For i = 1 To src.Rows.count
-        psum = 0
-        If src.Cells(i, CRM_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CRM_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CRM_HIR + 1)
-            psum = psum + src.Cells(i, CRM_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CRM_TER + 1)
-            psum = psum + src.Cells(i, CRM_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CRM_CAR + 1)
-            psum = psum + src.Cells(i, CRM_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CRM_PAT_LPU + 1) - psum
-        End If
-    Next i
-    
-    Worksheets("CHRT_PAT_LPU_A").Range("title") = MakeChartTitle
-    
-End Sub
-
-Sub btRM_LIST_RET_IT()
-    With Worksheets("RM_LIST")
-        .setEnt_date ("")
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = "PRJ_QTR"
-    End With
-    ThisWorkbook.Worksheets("PRJ_QTR").Activate
-End Sub
-
-
-Sub btRM_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim rm_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("RM_LIST_ACTION")
-    With Worksheets("RM_LIST")
-        rm_id = .getCurrentRM_ID()
-        
-        Select Case i
-            Case 1:
-                .SelectRM_QTR rm_id
-            Case 2:
-                .SelectREP_LIST rm_id
-            End Select
-    End With
-    
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-
-
-
-
-<<<<<<
-Project Name : 'ClexaneMR'
-Quirk - duff tag length======================
-Regs
->>>>>>
-Attribute VB_Name = "Regs"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-
-
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Dim AppRunEnable As New cEnableRun
-Dim MyAppEvents As New cAppEvents
-
-Private Sub Workbook_Open()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).ClearRepName
-    
-    Application.EnableEvents = True
-    Set MyAppEvents.app = Application
-    
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    Application.ScreenUpdating = False
-    
-    MyAppEvents.CheckWorkBooksArround ThisWorkbook
-    
-    cmSetStandaloneMode
-    
-    AppRunEnable.EnableRun ESTIMATION_DATE, Now
-    
-    Application.ScreenUpdating = True
-    
-    If CheckUser Then
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = False
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-        ThisWorkbook.Worksheets(REP_QTR_SHEET).update_history
-        Application.Calculate
-    End If
-End Sub
-
-Private Sub Workbook_BeforeClose(Cancel As Boolean)
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE") = True
-    
-    ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    
-    Dim RestMode As Boolean
-    RestMode = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE")
-    
-    If ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE").Value = False Then
-        Application.DisplayAlerts = False
-        Application.ScreenUpdating = False
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=False
-'        If RestMode Then
-            ThisWorkbook.Saved = True
-'        Else
-'            ThisWorkbook.Save
-'        End If
-    End If
-    If RestMode Then
-        xlRestoreView
-        ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = False
-    End If
-    Application.Caption = Empty
-    Application.CommandBars(STDBAR_NAME).Reset
-    
-End Sub
-
-Private Sub Workbook_SheetBeforeRightClick(ByVal sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
-    Cancel = Not ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE")
-End Sub
-
-Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
-    Dim MaxX, MaxY As Integer
-    With ThisWorkbook.Worksheets(REP_QTR_SHEET)
-        MaxX = .Range(BOTTOM_RIGH_WINDOW_CORNER).Left
-        MaxY = .Range(BOTTOM_RIGH_WINDOW_CORNER).Top
-    End With
-
-    With ThisWorkbook.Application
-        .ScreenUpdating = False
-        .WindowState = xlNormal
-        .Height = MaxY
-        .Width = MaxX
-    End With
-End Sub
-
-
-
-
-
-<<<<<<
-======================
-REP_QTR
->>>>>>
-Attribute VB_Name = "REP_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Const CINP_AREA As String = "B14"
-Const CQTR_QT As Integer = 0
-Const CQTR_ID As Integer = 1
-Const CQTR_PLN As Integer = 2
-Const CQTR_FCT As Integer = 3
-Const CQTR_BDG As Integer = 4
-Const CQTR_CNT As Integer = 5
-Const CQTR_BEDS As Integer = 6
-Const CQTR_HIR As Integer = 7
-Const CQTR_TER As Integer = 8
-Const CQTR_CRD As Integer = 9
-Const CQTR_CLXN_BDG As Integer = 10
-Const CQTR_CLXN_NMG As Integer = 11
-Const CQTR_PAT_ALL As Integer = 16
-Const CQTR_BDGT_ALL As Integer = 17
-
-
-Const CRow_Start As Integer = 2
-Const CRow_Finish As Integer = 13
-Const CRow_Width As Integer = CRow_Finish - CRow_Start + 1
-
-Dim currRange As Range
-
-Sub ClearRepName()
-    Unprotect
-    Range("D4") = ""
-    Range("D5") = ""
-    Range("H4") = ""
-    Range("H5") = ""
-End Sub
-
-Sub update_history()
-    Dim objQTR() As tQTR
-    Dim i As Long
-    Dim r As Range
-    Dim cRep As tREP
-    
-    cRep = GetREPRecord
-    Range("D4") = cRep.LastName
-    Range("D5") = cRep.FirstName
-    
-    Range("H4") = GetRegionName(cRep.Region)
-    Range("H5") = GetCityName(cRep.Region, cRep.City)
-    
-    Range("REP_QTR_INPUT_DATA").ClearContents
-    i = GetAll_QTR_Records(objQTR, "%")
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(objQTR)
-            r.Offset(i - 1, CQTR_QT) = objQTR(i).entry_date
-        Next i
-    End If
-    Dim qcd() As tQTR_COMMON
-    i = Get_QTR_CommonList(qcd)
-    If i > 0 Then
-        Set r = Range(CINP_AREA)
-        For i = 1 To UBound(qcd)
-            r.Offset(i - 1, CQTR_QT) = qcd(i).qtr.entry_date
-            r.Offset(i - 1, CQTR_ID) = qcd(i).qtr.id
-            r.Offset(i - 1, CQTR_PLN) = qcd(i).qtr.sale_plan
-            r.Offset(i - 1, CQTR_FCT) = qcd(i).c_sale_ALL
-            r.Offset(i - 1, CQTR_BDG) = qcd(i).c_bdgt_LPU
-            r.Offset(i - 1, CQTR_CNT) = qcd(i).i_lcd
-            r.Offset(i - 1, CQTR_BEDS) = qcd(i).c_beds
-            r.Offset(i - 1, CQTR_HIR) = qcd(i).c_pat_HIR
-            r.Offset(i - 1, CQTR_TER) = qcd(i).c_pat_TER
-            r.Offset(i - 1, CQTR_CRD) = qcd(i).c_pat_CRD
-            If qcd(i).c_bdgt_LPU <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_BDG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_LPU
-            End If
-            If qcd(i).c_bdgt_NMG <> 0 Then
-                r.Offset(i - 1, CQTR_CLXN_NMG) = qcd(i).c_sale_ALL / qcd(i).c_bdgt_NMG
-            End If
-        Next i
-    End If
-End Sub
-
-Sub Draw_BBL_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PAT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PAT_QTR").Range("CHRT_PAT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CQTR_CRD + 1)
-        End If
-    Next i
-End Sub
-
-
-Sub Draw_PLN_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_PLN_QTR").Range("CHRT_PLN_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_PLN + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_FCT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_BDGT_QTR()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Set dst = Worksheets("CHRT_BDGT_QTR").Range("CHRT_BDGT_QTR_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CQTR_QT + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CQTR_QT + 1)
-            dst.Cells(i, 2) = src.Cells(i, CQTR_CLXN_BDG + 1)
-            dst.Cells(i, 3) = src.Cells(i, CQTR_CLXN_NMG + 1)
-        End If
-    Next i
-End Sub
-
-Public Sub cbxRepQtrChart_Change()
-    Dim idx As Integer
-    Dim jmp_addr As String
-    idx = ThisWorkbook.Worksheets(VAR_SHEET).Range("QTR_CHR_IDX")
-    Select Case idx
-        Case 1
-            Draw_PAT_QTR
-            jmp_addr = "CHRT_PAT_QTR"
-        Case 2
-            Draw_PLN_QTR
-            jmp_addr = "CHRT_PLN_QTR"
-        Case 3
-            Draw_BDGT_QTR
-            jmp_addr = "CHRT_BDGT_QTR"
-    End Select
-    With ThisWorkbook.Worksheets(jmp_addr)
-        .Range("ret_addr") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(jmp_addr).Activate
-End Sub
-
-
-Private Sub Worksheet_Activate()
-  
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Set currRange = Range(CINP_AREA)
-    Range("LAST_FOCUS") = CINP_AREA
-
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    update_history
-    Range("QTR_SEL") = Range("REP_QTR_INPUT_DATA").Cells(1, 1)
-    currRange.Select
-    
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CRow_Width Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Set currRange = r_sel.Cells(1, 1)
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("REP_QTR_INPUT_DATA")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("REP_QTR_INPUT_DATA")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CRow_Start), Cells(rs.row, CRow_Finish))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CRow_Start), Cells(r.row, CRow_Finish)).Select
-    End If
-    Dim ent_date As String
-    ent_date = r.Cells(1, 1)
-    Range("QTR_SEL") = ent_date
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-
-    is_input_range = INPUT_NO
-
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim QTR_ID As Long
-    Dim ent_date As String
-    Dim i As Integer
-
-    Set r = Range(CINP_AREA).Cells(currRange.row - Range(CINP_AREA).row + 1, CQTR_ID + 1)
-
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-
-    i = currRange.Column - Range(CINP_AREA).Column
-    
-    QTR_ID = r
-
-    If QTR_ID = 0 Then
-        Worksheets(VAR_SHEET).Range("USER_ACTION") = 1
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    Else
-        If i > CQTR_FCT Then
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-            Range("LAST_FOCUS") = currRange.address
-        Else
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 3
-            Range("LAST_FOCUS") = currRange.address
-        End If
-    End If
-    Cancel = True
-    btHomeDo_IT
-End Sub
-
-<<<<<<
-======================
-mRep_QTR
->>>>>>
-Attribute VB_Name = "mRep_QTR"
-Option Explicit
-
-Sub DO_New_qtr()
-    Dim res As Variant
-    Dim objQTR As tQTR
-    Dim s As String
-    s = GetLastQtr
-    objQTR.entry_date = GetNextQTR(s)
-    
-    If objQTR.entry_date = "" Then
-        Exit Sub
-    End If
-    
-    DO_Price_qtr objQTR.entry_date
-
-End Sub
-
-Sub DO_Price_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        Dim qtr As tQTR
-        Dim res As Integer
-        
-        qtr = Get_QTR_Record(ent_date)
-        
-        If qtr.id = 0 Then
-            qtr.entry_date = ent_date
-    
-            With Worksheets(VAR_SHEET)
-                qtr.ClxnH20mg = .Range("ClxnH20mg")
-                qtr.ClxnH40mg = .Range("ClxnH40mg")
-                qtr.ClxnT40mg = .Range("ClxnT40mg")
-                qtr.ClxnC_ACS = .Range("ClxnC_ACS")
-                qtr.ClxnC_IM = .Range("ClxnC_IM")
-            End With
-        End If
-        
-        Dim dlg_nq As dlg_nextQTR
-        Set dlg_nq = New dlg_nextQTR
-        
-        With dlg_nq
-            .tb_qtr_name = qtr.entry_date
-            .tb_bdgt_avts = qtr.sale_plan
-            .tb_qtr_name = qtr.entry_date
-            .tb_ClxnH20mg = qtr.ClxnH20mg
-            .tb_ClxnH40mg = qtr.ClxnH40mg
-            .tb_ClxnT40mg = qtr.ClxnT40mg
-            .tb_ClxnC_ACS = qtr.ClxnC_ACS
-            .tb_ClxnC_IM = qtr.ClxnC_IM
-        End With
-        
-        dlg_nq.Show
-        res = dlg_nq.Tag
-        
-        If res = vbOK Then
-            With dlg_nq
-                If Not IsNumeric(.tb_bdgt_avts) Then
-                    MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                Else
-                    If .tb_bdgt_avts = 0 Then
-                        MsgBox "������� ���� ������", vbOK, PROGRAM_NAME
-                        Exit Sub
-                    End If
-                End If
-                Dim bool As Boolean
-                bool = IsNumeric(.tb_ClxnH20mg) _
-                    And IsNumeric(.tb_ClxnH40mg) _
-                    And IsNumeric(.tb_ClxnT40mg) _
-                    And IsNumeric(.tb_ClxnC_ACS) _
-                    And IsNumeric(.tb_ClxnC_IM)
-                If Not bool Then
-                    MsgBox "������� ��������� �����", vbOK, PROGRAM_NAME
-                    Exit Sub
-                End If
-                qtr.sale_plan = .tb_bdgt_avts
-                qtr.entry_date = .tb_qtr_name
-                qtr.ClxnH20mg = .tb_ClxnH20mg
-                qtr.ClxnH40mg = .tb_ClxnH40mg
-                qtr.ClxnT40mg = .tb_ClxnT40mg
-                qtr.ClxnC_ACS = .tb_ClxnC_ACS
-                qtr.ClxnC_IM = .tb_ClxnC_IM
-            End With
-            Insert_QTR_Record qtr
-        End If
-    End If
-End Sub
-
-Sub DO_Edit_qtr(ent_date As String)
-    If ent_date = "" Then
-        DO_New_qtr
-    Else
-        With ThisWorkbook.Worksheets("LPU_LIST")
-            .Range("VIEW_ONLY") = False
-            .Range("ent_date") = ent_date
-            .Select
-        End With
-    End If
-End Sub
-
-Sub DO_Delete_qtr(ent_date As String)
-    If ent_date <> "" Then
-        Dim i As Integer
-        i = MsgBox("������� ������ �� ������ [" & ent_date & "]?", vbDefaultButton2 + vbOKCancel, PROGRAM_NAME)
-        If i = vbOK Then
-            Dim objQTR As tQTR
-            If ent_date <> "" Then
-                objQTR.entry_date = ent_date
-                objQTR = Get_QTR_Record(ent_date)
-                Delete_QTR_Record objQTR
-                Worksheets(TITLE_SHEET).Select
-                Worksheets(REP_QTR_SHEET).Select
-            End If
-        End If
-    End If
-    Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-End Sub
-
-
-Sub btHomeDo_IT()
-    Dim ent_date As String
-    Dim idx As Integer
-    idx = Worksheets(VAR_SHEET).Range("USER_ACTION")
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    Select Case idx
-        Case 1
-            DO_New_qtr
-            ' ��������� �����
-        Case 2
-            DO_Edit_qtr ent_date
-        Case 3
-            DO_Price_qtr ent_date
-        Case 4
-            dbExport
-            Worksheets(VAR_SHEET).Range("USER_ACTION") = 2
-    End Select
-    If idx <> 2 Then
-        With ThisWorkbook
-            .Worksheets(TITLE_SHEET).Select
-            .Worksheets(REP_QTR_SHEET).Select
-        End With
-    End If
-End Sub
-
-Sub Delete_qtr()
-    Dim ent_date As String
-    ent_date = Worksheets(REP_QTR_SHEET).Range("QTR_SEL")
-    DO_Delete_qtr ent_date
-End Sub
-
-<<<<<<
-======================
-mConst
->>>>>>
-Attribute VB_Name = "mConst"
-Option Explicit
-
-Public Const PROGRAM_NAME As String = "Aventis Pharma Clexane[MR]"
-Public Const PROGRAM_VERSION As String = "version 1.6"
-Public Const PROGRAM_FILENAME As String = "clexane-mr"
-Public Const PROGRAM_EXPORTNAME As String = "mr-ex-"
-Public Const PROGRAM_DATAEXT As String = ".mdb"
-
-Public Const NO_ESTIMATION_DATE As Long = -1
-Public Const DEVELOP_MODE As Boolean = True
-
-'Public Const ESTIMATION_DATE As Long = 20030329
-Public Const ESTIMATION_DATE As Long = NO_ESTIMATION_DATE
-
-Public Const BOTTOM_RIGH_WINDOW_CORNER As String = "O40"
-'Public Const CITY_TABLES As String = "N30"
-
-Public Const VAR_SHEET As String = "Var"
-Public Const REGS_SHEET As String = "Regs"
-Public Const TITLE_SHEET As String = "title"
-Public Const REP_QTR_SHEET As String = "REP_QTR"
-
-' �������� ����� REP_QTR
-Public Const DEF_IDX_REGION As Integer = 1
-Public Const DEF_IDX_CITY As Integer = 2
-
-<<<<<<
-======================
-mTools
->>>>>>
-Attribute VB_Name = "mTools"
-Option Explicit
-
-Function MakeNewFileName(f_name As String, s_name As String, u_city As String) As String
-    MakeNewFileName = s_name & "." & f_name & "." & u_city & ".xls"
-End Function
-
-Sub dummy()
-End Sub
-
-Function Double2Str(ByVal d As Double, ByVal precision As Integer, Optional Delim As String = ".") As String
-    Dim s As String
-    If Not precision > 0 Then
-        s = Round(d)
-    Else
-        Dim i As Integer
-        i = Fix(d)
-        s = i & Delim
-        d = Abs(d - i)
-        Do
-            precision = precision - 1
-            d = d * 10
-            If precision > 0 Then
-                i = Fix(d)
-            Else
-                i = Round(d)
-            End If
-            If i < 1 Then
-                s = s & "0"
-            Else
-                s = s & i
-                d = d - i
-            End If
-        Loop While precision > 0
-    End If
-    Double2Str = s
-End Function
-
-Function GetWBPath(FullName As String) As String
-    Dim pos, s_len As Integer
-    pos = InStrRev(FullName, "\")
-    s_len = Len(FullName)
-    GetWBPath = Left(FullName, pos)
-End Function
-
-Function GetLinesCount(ByVal Location As Range) As Integer
-    Dim n As Integer
-    n = 0
-    Do While IsEmpty(Location.Offset(n, 0).Value) = False
-        n = n + 1
-    Loop
-    GetLinesCount = n
-End Function
-
-Function GetStrIndex(r As Range, s As String)
-    Dim n As Integer
-    GetStrIndex = -1
-    For n = 1 To r.Count
-        If r.Offset(0, n - 1).Value = s Then
-            GetStrIndex = n - 1
-            Exit Function
-        End If
-    Next n
-End Function
-
-Sub tool_RestoreCursor()
-    Application.Cursor = xlDefault
-End Sub
-
-Sub SetDesignFlagOn()
-    Dim sh As Worksheet
-    
-    Application.ScreenUpdating = False
-    For Each sh In Worksheets
-        sh.Unprotect
-        sh.Visible = xlSheetVisible
-    Next sh
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-    Application.ScreenUpdating = True
-End Sub
-
-Sub SetDesignFlagOff()
-    Application.ScreenUpdating = False
-    
-    Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = False
-    
-    Dim sh As Worksheet
-    For Each sh In Worksheets
-        If sh.name = VAR_SHEET Or sh.name = REGS_SHEET Then
-            sh.Visible = xlSheetVeryHidden
-            sh.Unprotect
-        Else
-            sh.Protect UserInterfaceOnly:=True
-        End If
-    Next sh
-    Application.ScreenUpdating = True
-End Sub
-
-
-<<<<<<
-======================
-Var
->>>>>>
-Attribute VB_Name = "Var"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-title
->>>>>>
-Attribute VB_Name = "title"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-LPU_LIST
->>>>>>
-Attribute VB_Name = "LPU_LIST"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-Const CINP_FIRST_R As Integer = 2
-Const CINP_LAST_R As Integer = 13
-Const CINP_WIDTH As Integer = CINP_LAST_R - CINP_FIRST_R + 1
-
-Public Function getEnt_date() As String
-    getEnt_date = Range("ent_date")
-End Function
-
-Public Function getCurrentLPU_ID() As Long
-    Dim r As Range
-    
-    With Worksheets("LPU_LIST")
-        Set r = .Range(CINP_AREA).Offset(.Range(.Range("LAST_FOCUS")).row - .Range(CINP_AREA).row, CLPU_ID)
-    End With
-    
-    getCurrentLPU_ID = r
-End Function
-
-Public Sub LPU_ViewChart()
-    Dim src As Range
-    Dim dst As Range
-    Select Case Worksheets(VAR_SHEET).Range("LPU_CHR_IDX")
-        Case 1
-            Draw_BBL_Chart
-            With Worksheets("CHRT_LPU_BBL")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_LPU_BBL"
-
-        Case 2
-            Draw_PAT_LPU
-            With Worksheets("CHRT_PAT_LPU")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            Range("JUMP") = "CHRT_PAT_LPU"
-
-        Case 3
-            Draw_PIE_Chart
-            With Worksheets("CHRT_PIE")
-                .Range("ret_addr") = "LPU_LIST"
-            End With
-            
-            Range("JUMP") = "CHRT_PIE"
-    End Select
-
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Activate
-    End If
-End Sub
-
-Public Sub SelectLPU_NAME(lpu_id As Long, ent_date As String)
-    If Range("VIEW_ONLY") = True Then
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    Dim cLPU As tLPU
-    If lpu_id = 0 Then
-        cLPU.id = 0
-        cLPU.rep_id = 0
-        cLPU.address = ""
-        cLPU.name = ""
-    Else
-        cLPU = Get_LPU_Record(lpu_id)
-    End If
-    EditLPU cLPU, getEnt_date
-    Worksheet_Activate
-End Sub
-        
-Sub SelectLPU_BDGT(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    If lpu_id = 0 Then
-        SelectLPU_NAME lpu_id, ent_date
-    Else
-        With ThisWorkbook.Worksheets("LPU_BDGT")
-            .Range("VIEW_ONLY") = vo
-            .Range("ret_addr") = "LPU_LIST"
-            .Range("ent_date") = ent_date
-            .Range("lpu_id") = lpu_id
-        End With
-    End If
-End Sub
-
-Sub SelectLPU_HIR(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_HIR")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-                   
-Sub SelectLPU_TER(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_TER")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-       
-Sub SelectLPU_C_ACS(lpu_id As Long, ent_date As String)
-    Dim vo As Boolean
-    vo = Range("VIEW_ONLY")
-    With ThisWorkbook.Worksheets("LPU_CLSN_C_ACS")
-        .Range("VIEW_ONLY") = vo
-        .Range("ret_addr") = "LPU_LIST"
-        .Range("ent_date") = ent_date
-        .Range("lpu_id") = lpu_id
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect UserInterfaceOnly:=True
-
-    If am_load_now Then
-        Exit Sub
-    End If
-
-    Range("LAST_FOCUS") = CINP_AREA
-
-    UpdateLPUList
-
-    InpRowSelect Range(Range("LAST_FOCUS"))
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim r_sel As Range
-    If Not chk_input_range(Target) Then
-        Set r_sel = Range(CINP_AREA)
-    Else
-        Set r_sel = Target
-    End If
-
-    If r_sel.Columns.Count > 1 And r_sel.Columns.Count < CINP_WIDTH Or r_sel.Rows.Count > 1 Then
-        Set r_sel = r_sel.Cells(1, 1)
-    End If
-
-    If r_sel.Count = 1 Then
-        Range("LAST_FOCUS") = r_sel.address
-        InpRowSelect r_sel
-    End If
-End Sub
-
-Function chk_input_range(r As Range) As Boolean
-    Dim a As Range
-    Set a = Range("LPU_LIST_INPUT")
-    chk_input_range = r.row <= (a.Rows.Count + a.row) And r.row >= a.row _
-    And r.Column <= (a.Columns.Count + a.Column) And r.Column >= a.Column
-End Function
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-    Dim r As Range
-    Dim lpu_id As Long
-    Dim ent_date As String
-    Dim i As Integer
-    
-    ent_date = getEnt_date
-    If ent_date = "" Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    Set r = Range(CINP_AREA).Offset(Range(Range("LAST_FOCUS")).row - Range(CINP_AREA).row, CLPU_ID)
-        
-    If Not chk_input_range(r) Then
-        Cancel = True
-        Exit Sub
-    End If
-    
-    lpu_id = r
-    
-    i = Range(Range("LAST_FOCUS")).Column - Range(CINP_AREA).Column
-    
-    If lpu_id = 0 Then
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-    End If
-    
-    If lpu_id = 0 Then
-        i = CLPU_NAME
-        Range("JUMP") = ""
-    End If
-    Select Case i
-        Case CLPU_NAME, CLPU_NAME1, CLPU_NAME2, CLPU_BEDS
-            SelectLPU_NAME lpu_id, ent_date
-            Range("JUMP") = ""
-
-        Case CLPU_NMG, CLPU_NFG, CLPU_PLAN, CLPU_FACT
-            SelectLPU_BDGT lpu_id, ent_date
-            Range("JUMP") = "LPU_BDGT"
-            
-        Case CLPU_HIR
-            SelectLPU_HIR lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_HIR"
-        
-        Case CLPU_TER
-            SelectLPU_TER lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_TER"
-        
-        Case CLPU_CAR
-            SelectLPU_C_ACS lpu_id, ent_date
-            Range("JUMP") = "LPU_CLSN_C_ACS"
-        
-        Case Else
-            Range("JUMP") = ""
-    End Select
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-    Cancel = True
-End Sub
-
-
-Sub InpRowSelect(rs As Range)
-    Dim r As Range
-    If is_input_range(rs, Range("LPU_LIST_INPUT")) > INPUT_NO Then
-        Set r = Range(Cells(rs.row, CINP_FIRST_R), Cells(rs.row, CINP_LAST_R))
-        r.Select
-    Else
-        Range("LAST_FOCUS") = Range(CINP_AREA).address
-        Set r = Range(CINP_AREA)
-        Range(Cells(r.row, CINP_FIRST_R), Cells(r.row, CINP_LAST_R)).Select
-    End If
-End Sub
-
-Function is_input_range(ByVal Target As Range, inputs As Range) As Integer
-    Dim r As Range
-    
-    is_input_range = INPUT_NO
-    
-    For Each r In inputs
-        If r.address = Target.address Then
-            is_input_range = INPUT_CHECK
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub UpdateLPUList()
-    Dim lcd() As tLPU_COMMON
-    
-    Dim ent_date As String
-    Dim i As Long
-    Dim r As Range
-    Dim t_sum As Long
-    Dim objQTR As tQTR
-    Dim cRep As tREP
-    
-    ' ent_date = "%" ' % - all records
-    ent_date = getEnt_date
-    
-    objQTR = Get_QTR_Record(ent_date)
-    i = Get_LPU_CommonQTR(lcd, objQTR)
-     
-    ' ������� ���
-    Range("C3:C4").ClearContents
-    cRep = GetREPRecord
-    
-    Range("C3") = cRep.LastName
-    Range("C4") = cRep.FirstName
-    Range("G3") = GetRegionName(cRep.Region)
-    Range("G4") = GetCityName(cRep.Region, cRep.City)
-    Range("G5") = objQTR.sale_plan
-    
-
-    
-    With ThisWorkbook.Worksheets("LPU_LIST")
-        .Range("LPU_LIST_INPUT").ClearContents
-        .Range("LPU_INPUT_EXT").ClearContents
-    End With
-
-    If i <> 0 Then
-        Set r = Range(CINP_AREA)
-        
-        For i = 1 To UBound(lcd)
-            r.Offset(i - 1, CLPU_NAME) = lcd(i).lpu.name
-            r.Offset(i - 1, CLPU_ID) = lcd(i).lpu.id
-            r.Offset(i - 1, CLPU_BEDS) = lcd(i).lpu.beds
-            
-         
-            r.Offset(i - 1, CLPU_NFG) = lcd(i).bdgt.bdgt_NFG
-            r.Offset(i - 1, CLPU_NMG) = lcd(i).bdgt.bdgt_NMG
-            r.Offset(i - 1, CLPU_PLAN) = lcd(i).bdgt.sale_plan
-            
-            r.Offset(i - 1, CLPU_HIR) = lcd(i).pat_HIR
-            r.Offset(i - 1, CLPU_TER) = lcd(i).pat_TER
-            r.Offset(i - 1, CLPU_CAR) = lcd(i).pat_CRD
-            r.Offset(i - 1, CLPU_FACT) = lcd(i).sale_ALL
-            r.Offset(i - 1, CLPU_PAT_LPU) = lcd(i).pat_LPU
-            r.Offset(i - 1, CLPU_BDGT) = lcd(i).bdgt_LPU
-            If lcd(i).bdgt_LPU > 0 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = lcd(i).sale_ALL / lcd(i).bdgt_LPU
-            End If
-            If r.Offset(i - 1, CLPU_BDGT + 1) > 1 Then
-                r.Offset(i - 1, CLPU_BDGT + 1) = 1
-            End If
-            
-        Next i
-    End If
-End Sub
-<<<<<<
-======================
-dlgPrint
->>>>>>
-Attribute VB_Name = "dlgPrint"
-Attribute VB_Base = "0{566B33D6-957A-43E4-8444-D8EA3889700C}{42EE65B8-F8C6-4F95-9F52-7738BF6FCEAD}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbAllSheets_Click()
-    If Me.cbAllSheets = True Then
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-        Me.cbSrcData = True
-    End If
-End Sub
-
-Private Sub cbMainBudget_Click()
-    If Me.cbMainBudget = False Then
-        Me.cbAllSheets = False
-        Me.cbSrcData = False
-    Else
-        Me.cbMainReport = True
-    End If
-End Sub
-
-Private Sub cbMainReport_Click()
-    If Me.cbMainReport = False Then
-        Me.cbAllSheets = False
-        Me.cbMainBudget = False
-        Me.cbSrcData = False
-    End If
-End Sub
-
-Private Sub cbSrcData_Click()
-    If Me.cbSrcData = False Then
-        Me.cbAllSheets = False
-    Else
-        Me.cbMainBudget = True
-        Me.cbMainReport = True
-    End If
-End Sub
-<<<<<<
-======================
-dbACS
->>>>>>
-Attribute VB_Name = "dbACS"
-Option Explicit
-
-Public Type tACS
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    patients_with_geparins As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objACS.ID <> 0 then updatre else insert
-Sub Insert_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objACS.id <> 0 Then
-        dbUpdate_ACS_Record dbConnection, objACS
-    Else
-        dbInsert_ACS_Record dbConnection, objACS
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_ACS_RecordsByLPU_ID(ByRef all_ACS_() As tACS, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_ACS_RecordsByLPU_ID = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, all_ACS_, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_ACS_Record(ByRef objACS As tACS)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_ACS_Record dbConnection, objACS
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub dbInsert_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_acs", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objACS
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("patients_with_geparins") = .patients_with_geparins
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objACS.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    Dim Update_SQL As String
-    
-    With objACS
-        Update_SQL = "UPDATE lpu_acs SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "patients_with_geparins=" & .patients_with_geparins & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_ACS_RecordsbyLPU_ID(dbConnection As Object, all_ACS() As tACS, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_ACS_SQL As String
-    Dim getAll_ACS_SQL As String
-    Dim ACS_Count As Long
-    ACS_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_ACS_SQL = "SELECT COUNT(*) AS ACS_TOTAL FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_ACS_SQL = "SELECT * FROM lpu_acs WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_ACS_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        ACS_Count = dbRecordset("ACS_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_ACS_RecordsbyLPU_ID = ACS_Count
-    
-    If ACS_Count > 0 Then
-        'we have records
-        ReDim all_ACS(1 To ACS_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_ACS_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_ACS As tACS
-                 With tmp_ACS
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .patients_with_geparins = dbRecordset("patients_with_geparins")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 all_ACS(index) = tmp_ACS
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_ACS_Record(dbConnection As Object, ByRef objACS As tACS)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE ID=" & objACS.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_acs " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_ACS_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_ACS_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_acs " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_HIR
->>>>>>
-Attribute VB_Name = "LPU_CLSN_HIR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-    
-        Dim objHir As tHIRURGIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objHir
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .operations_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L9")
-                .patients_ambulator_clexan_20mg = Range("L10")
-                .patients_ambulator_clexan_40mg = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L19")
-                .patients_stationar_clexan_20mg = Range("L20")
-                .patients_stationar_clexan_40mg = Range("L21")
-            End With
-            Insert_Hir_Record objHir
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objHir.id = Range("rec_id")
-                    If objHir.id <> 0 Then
-                        Delete_Hir_Record objHir
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objHir As tHIRURGIA)
-    Dim qtr As tQTR
-    Dim formula As String
-
-    With objHir
-        Range("rec_id") = .id
-        Range("F6") = .operations_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L9") = .patients_ambulator_clexan
-        Range("L10") = .patients_ambulator_clexan_20mg
-        Range("I21") = .patients_stationar_nmg
-        Range("L19") = .patients_stationar_clexan
-        Range("L20") = .patients_stationar_clexan_20mg
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnH20mg & "*($L$10+$L$20)+" & qtr.ClxnH40mg & "*($L$11+$L$21)"
-        Range("F11").formula = formula
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objHir() As tHIRURGIA
-        Dim i As Integer
-        i = GetAll_Hir_RecordsByLPU_ID(objHir, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.3
-        Else
-            SetupData objHir(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-
-    Dim s As String
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    Select Case iset.vType
-        Case INPUT_NO
-
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-
-            Application.ScreenUpdating = False
-
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-
-        Case INPUT_STRING
-
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-mSapes
->>>>>>
-Attribute VB_Name = "mSapes"
-Option Explicit
-
-Const SHAPE_COLOR As Integer = 1
-Const SHAPE_NAME As Integer = 2
-
-
-Sub ShapeView(r_sh_finite_state As Range)
-    Dim chk As Range
-    Dim s As String
-    Dim c, idx As Integer
-    For Each chk In r_sh_finite_state
-        idx = 0
-        If chk = "+" Then
-            c = chk.Offset(0, idx + SHAPE_COLOR)
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While c <> 0
-                ShapeFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s)), c
-                idx = idx + 2
-                c = chk.Offset(0, idx + SHAPE_COLOR)
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        Else
-            s = chk.Offset(0, idx + SHAPE_NAME)
-            Do While s <> ""
-                ShapeUnFill r_sh_finite_state.Worksheet.Shapes.Range(Array(s))
-                idx = idx + 2
-                s = chk.Offset(0, idx + SHAPE_NAME)
-            Loop
-        End If
-    Next chk
-End Sub
-
-Sub ShapeFill(sh As ShapeRange, ByVal color As Integer)
-    sh.Fill.Visible = msoTrue
-    sh.Fill.Solid
-    sh.Fill.ForeColor.SchemeColor = color
-    sh.Fill.Transparency = 0#
-End Sub
-
-Sub ShapeUnFill(sh As ShapeRange)
-    sh.Fill.Visible = msoFalse
-    sh.Fill.Transparency = 0#
-End Sub
-
-<<<<<<
-======================
-mCheck
->>>>>>
-Attribute VB_Name = "mCheck"
-Option Explicit
-
-Public Const INPUT_NO = 0
-Public Const INPUT_NUMBER = 1
-Public Const INPUT_PERCENT = 2
-Public Const INPUT_STRING = 3
-Public Const INPUT_CHECK = 4
-
-Public Const INP_IDX_TYPE = 1
-Public Const INP_IDX_NEXT = 2
-Public Const INP_IDX_MIN = 3
-Public Const INP_IDX_MAX = 4
-Public Const INP_IDX_DEP = 5
-Public Const INP_IDX_ALT = 7
-
-
-Public Type tInputSet
-    vType As Integer
-    vMin As Long
-    vMax As Long
-    rChk As String
-End Type
-
-Function is_input_cell(ByVal Target As Range, inputs As Range) As tInputSet
-    Dim t As Range
-    Dim iset As tInputSet
-    Dim test As Range
-    iset.vType = INPUT_NO
-    iset.vMin = 0
-    iset.vMax = 0
-    iset.rChk = ""
-    is_input_cell = iset
-
-' ��������������� ��������� ������ ��� ������
-'  Exit Function
-
-    Set test = Target.Cells(1, 1)
-    For Each t In inputs
-        If Range(t).Column = test.Column And Range(t).row = test.row Then
-            iset.vType = t.Offset(0, INP_IDX_TYPE).Value
-            Select Case iset.vType
-                Case INPUT_CHECK
-                    iset.rChk = t.Offset(0, INP_IDX_ALT)
-                Case INPUT_NUMBER, INPUT_PERCENT
-                    iset.vMin = t.Offset(0, INP_IDX_MIN).Value
-                    iset.vMax = t.Offset(0, INP_IDX_MAX).Value
-            End Select
-            is_input_cell = iset
-            Exit Function
-        End If
-    Next t
-End Function
-
-Function GetFocusAddress(ByVal r As Range, f_next As Range) As String
-    Dim chk, t As Range
-    
-    For Each chk In f_next
-        For Each t In r
-            If t.address = chk Then
-                GetFocusAddress = chk
-                Exit Function
-            End If
-            If Range(chk).Column = t.Column - 1 And Range(chk).row = t.row _
-            Or Range(chk).Column = t.Column And Range(chk).row = t.row - 1 _
-            Then
-                If Range(chk) <> "" Then
-                    If Range(chk) = 0 Then
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_ALT)).address
-                    Else
-                        GetFocusAddress = Range(chk.Offset(0, INP_IDX_NEXT)).address
-                    End If
-                Else
-                    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-                End If
-                Exit Function
-            End If
-        Next t
-    Next chk
-    GetFocusAddress = r.Worksheet.Range("DEF_FOCUS")
-End Function
-
-Sub SetDependet(r As Range, inputs As Range)
-    Dim chk As Range
-    Dim s, serr As String
-    Dim idx As Integer
-    Dim iset As tInputSet
-    Dim err_found As Boolean
-    
-    If r.Count > 1 Then
-        Exit Sub
-    End If
-    
-    err_found = False
-    For Each chk In inputs
-        idx = INP_IDX_DEP
-        
-        
-        iset.vType = chk.Offset(0, INP_IDX_TYPE).Value
-        Select Case iset.vType
-            Case INPUT_NUMBER, INPUT_PERCENT
-                iset.vMin = chk.Offset(0, INP_IDX_MIN).Value
-                iset.vMax = chk.Offset(0, INP_IDX_MAX).Value
-                
-                If Range(chk) > iset.vMax Then
-                    err_found = True
-                    Range(chk) = iset.vMax
-                    serr = "����� �� ����������� �������� [" & iset.vMin & ".." & iset.vMax & "]! ������ ���������������."
-                End If
-                
-                If Range(chk) = "" Then
-                    s = chk.Offset(0, idx)
-                    Do While s <> ""
-                        Range(s) = ""
-                        idx = idx + 1
-                        s = chk.Offset(0, idx)
-                    Loop
-                End If
-        End Select
-    Next chk
-    If err_found Then
-        MsgBox serr, vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Function CheckInputData(inputs As Range) As Boolean
-    Dim r As Range
-    
-    CheckInputData = True
-    For Each r In inputs
-        If Range(r) = "" Then
-            CheckInputData = False
-            Exit Function
-        End If
-    Next r
-End Function
-
-Sub Check_Percent(Target As Range, Def_Val As Double)
-    Dim test, test2 As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    test2 = False
-    For Each r In Target
-        str = r
-        test = False
-        With WorksheetFunction
-            If Not .IsNumber(r) And r.Text <> "" Then
-                r = Def_Val
-                test = True
-            Else
-                test = (r > 1 Or r < 0)
-            End If
-        End With
-        test2 = test2 Or test
-    Next r
-    If test2 Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ ����� �� 0 �� 100.", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-Sub Check_Int_Number(Target As Range, Def_Val As Long)
-    Dim err As Boolean
-    Dim str As String
-    Dim r As Range
-    
-    err = False
-    For Each r In Target
-        If r.Text <> "" Then
-            str = Target
-            If Not WorksheetFunction.IsNumber(Target) Then
-                Target = Def_Val
-                err = True
-            End If
-        End If
-    Next r
-    If err Then
-        MsgBox "������ ������ - '" & str & "'!  ����������� ������ �����!", vbOKOnly, PROGRAM_NAME
-    End If
-End Sub
-
-
-<<<<<<
-======================
-LPU_CLSN_TER
->>>>>>
-Attribute VB_Name = "LPU_CLSN_TER"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub ClearData()
-    Dim r As Range
-    Set r = Range(Range("DEF_FOCUS"))
-    ClearSheetData r
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim objTer As tTERAPIA
-        
-        If Range(Range("DEF_FOCUS")) <> 0 Then
-            With objTer
-                .id = Range("rec_id")
-                .entry_date = Range("ent_date")
-                .lpu_id = Range("lpu_id")
-                .patients_per_quarter = Range("F6")
-                .risk_percent = Range("F8")
-                .patients_with_risk_ON = Range("C21")
-                .patients_ambulator = Range("F18")
-                .patients_ambulator_nmg = Range("I12")
-                .patients_ambulator_clexan = Range("L11")
-                .patients_stationar_nmg = Range("I21")
-                .patients_stationar_clexan = Range("L20")
-            End With
-            Insert_Ter_Record objTer
-            ClearData
-        Else
-            If Range("rec_id") <> 0 Then
-                If vbOK = MsgBox("������� ������ �� ����!", vbOKCancel, PROGRAM_NAME) Then
-                    objTer.id = Range("rec_id")
-                    If objTer.id <> 0 Then
-                        Delete_Ter_Record objTer
-                    End If
-                End If
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-        ClearData
-    End If
-
-    ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(objTer As tTERAPIA)
-    Dim qtr As tQTR
-    Dim formula As String
-    With objTer
-        Range("rec_id") = .id
-        Range("F6") = .patients_per_quarter
-        Range("F8") = .risk_percent
-        Range("C21") = .patients_with_risk_ON
-        Range("F18") = .patients_ambulator
-        Range("I12") = .patients_ambulator_nmg
-        Range("L11") = .patients_ambulator_clexan
-        Range("I21") = .patients_stationar_nmg
-        Range("L20") = .patients_stationar_clexan
-        
-        qtr = Get_QTR_Record(.entry_date)
-        formula = "=" & qtr.ClxnT40mg & "*($L$12+$L$20)"
-        Range("F11").formula = formula
-        
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Dim lpu As tLPU
-    Dim id As Long
-    
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    Range("h_DepFlag") = False
-    
-    id = Range("lpu_id").Value
-    lpu = Get_LPU_Record(id)
-    If lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = lpu.beds
-        Range("lpu_name") = lpu.name
-        Range("lpu_addr") = lpu.address
-
-        Dim objTer() As tTERAPIA
-        Dim i As Integer
-        i = GetAll_Ter_RecordsByLPU_ID(objTer, id, Range("ent_date"))
-        If i = 0 Then
-            Range("rec_id") = 0
-            Range("F8") = 0.25
-        Else
-            SetupData objTer(1)
-        End If
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    If Range("h_DepFlag") Then
-        Exit Sub
-    End If
-    
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-            Application.ScreenUpdating = False
-            
-            Range("h_DepFlag") = True
-            SetDependet Target, Range("h_Inputs")
-            Range("h_DepFlag") = False
-            
-            ShapeView Range("h_check")
-            Application.ScreenUpdating = True
-
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case Else
-    End Select
-End Sub
-
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-    iset = is_input_cell(Target, Range("h_Inputs"))
-
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgAbout
->>>>>>
-Attribute VB_Name = "dlgAbout"
-Attribute VB_Base = "0{EBA94131-180E-4709-A2A3-B60D48987620}{47A860A1-BF92-4EBB-A333-AB7E83FAB868}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-
-Private Sub OK_Button_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-LPU_BDGT
->>>>>>
-Attribute VB_Name = "LPU_BDGT"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Public Sub SetDefFocus()
-    Range(Range("DEF_FOCUS")).Select
-End Sub
-
-Public Sub ClearData()
-    ClearSheetData
-End Sub
-
-Sub ClearSheetData()
-    If Range("F10") = 0 And Range("F13") = 0 Then
-        Range("F11:F18") = ""
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("F11:F13") = ""
-    End If
-End Sub
-
-Public Sub SaveData()
-    If Range("VIEW_ONLY") = False Then
-        Dim bdgt As tBUDGET
-        Dim sum As Long
-        Dim test As Boolean
-        With bdgt
-            .lpu_id = Range("lpu_id")
-            .id = Range("rec_id")
-            .entry_date = Range("ent_date")
-            .bdgt_NMG = Round(Range("F11").Value, 0)
-            .bdgt_NFG = Round(Range("F12").Value, 0)
-            .sale_plan = Round(Range("F13").Value, 0)
-            
-            sum = .bdgt_NFG + .bdgt_NMG - .sale_plan
-            test = .bdgt_NFG <> 0 Or .bdgt_NMG <> 0 Or .sale_plan <> 0
-        End With
-        If test Then
-            If sum < 0 Then
-                MsgBox _
-                    "��� ���� ��������� ���������� �� �������� ������. ��������� ������?", _
-                    vbOKOnly, PROGRAM_NAME
-            End If
-            If test Then
-                Insert_BDGT_Record bdgt
-            End If
-        Else
-            If bdgt.id <> 0 Then
-                If vbYes = MsgBox("��������� ������� ��������?", vbYesNo, PROGRAM_NAME) Then
-                    Insert_BDGT_Record bdgt
-                End If
-                ret_back Range("DEF_FOCUS").Worksheet
-                Exit Sub
-            End If
-        End If
-    Else
-        MsgBox "����� ������ ��������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-    
-   ClearData
-   ret_back Range("DEF_FOCUS").Worksheet
-End Sub
-
-Sub SetupData(cLPU As tLPU_COMMON)
-    Dim t_sum As Long
-    t_sum = 0
-' Setup budget data
-    Range("F11") = cLPU.bdgt.bdgt_NMG
-    Range("F12") = cLPU.bdgt.bdgt_NFG
-    Range("F13") = cLPU.bdgt.sale_plan
-    
-    With cLPU
-        Range("F14") = .pat_ALL
-        Range("F15") = .pat_HIR
-        Range("F16") = .pat_TER
-        Range("F17") = .pat_CRD
-        Range("F18") = .sale_ALL
-    End With
-End Sub
-
-Private Sub Worksheet_Activate()
-    Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    ws_activate
-End Sub
-
-
-Sub ws_activate()
-    Dim cLPU As tLPU_COMMON
-    Dim objQTR As tQTR
-    Dim objLPU As tLPU
-    Dim ent_date As String
-    Dim id As Long
-    
-    If am_load_now Then
-        Exit Sub
-    End If
-    
-    id = Range("lpu_id").Value
-    ent_date = Range("ent_date")
-    objQTR = Get_QTR_Record(ent_date)
-    objLPU = Get_LPU_Record(id)
-    Get_LPU_Common cLPU, objLPU, objQTR
-    
-    If cLPU.lpu.id <> id And Range("ret_addr") <> "" Then
-        MsgBox "�������� ���� ������", vbOKOnly, PROGRAM_NAME
-        ret_back Range("DEF_FOCUS").Worksheet
-    Else
-        Range("A1").Select
-
-        Range("lpu_beds") = cLPU.lpu.beds
-        Range("lpu_name") = cLPU.lpu.name
-        Range("lpu_addr") = cLPU.lpu.address
-        Range("rec_id") = cLPU.bdgt.id
-        
-        SetupData cLPU
-        
-        Range(Range("DEF_FOCUS")).Select
-    End If
-
-End Sub
-
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-'    MsgBox Target.address
-    Cancel = True
-End Sub
-
-Private Sub Worksheet_Change(ByVal Target As Range)
-    Dim s As String
-    Dim iset As tInputSet
-    
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    
-    Select Case iset.vType
-        Case INPUT_NO
-        
-        Case INPUT_NUMBER
-            Check_Int_Number Target, iset.vMax
-            
-        Case INPUT_PERCENT
-        
-        Case INPUT_STRING
-        
-        Case INPUT_CHECK
-            
-        Case Else
-    End Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Dim iset As tInputSet
-
-    iset = is_input_cell(Target, Range("h_Inputs"))
-    wks_sel_chng iset, Target, Range("DEF_FOCUS").Worksheet
-End Sub
-<<<<<<
-======================
-dlgGetPwd
->>>>>>
-Attribute VB_Name = "dlgGetPwd"
-Attribute VB_Base = "0{E3F10C5A-A4B4-42FF-A2C9-6F8198210A07}{563D0F3D-F79D-48F1-AFE4-A2136809B982}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btnSubmit_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mSheets
->>>>>>
-Attribute VB_Name = "mSheets"
-Option Explicit
-
-Function am_load_now() As Boolean
-    am_load_now = ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_LOAD_MODE")
-End Function
-
-Sub Wks_select(RetSheet As String)
-    Dim sheet As Worksheet
-    For Each sheet In ThisWorkbook.Worksheets
-        If sheet.name = RetSheet Then
-            ThisWorkbook.Worksheets(RetSheet).Select
-            Exit Sub
-        End If
-    Next sheet
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub ret_back(sh As Worksheet)
-    Dim RetSheet As String
-    RetSheet = sh.Range("ret_addr")
-    sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    sh.Range("ret_addr") = ""
-    sh.Range("rec_id") = ""
-    sh.Range("lpu_id") = ""
-    sh.Range("ent_date") = ""
-    sh.Range("lpu_name") = ""
-    sh.Range("lpu_addr") = ""
-    sh.Range("lpu_beds") = ""
-    Wks_select RetSheet
-End Sub
-
-Sub ClearSheetData(r_start As Range)
-    If r_start <> "" Then
-        r_start.Worksheet.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-        r_start = ""
-    Else
-        ret_back r_start.Worksheet
-    End If
-End Sub
-
-Sub wks_sel_chng(iset As tInputSet, ByVal Target As Range, sh As Worksheet)
-    Dim DebugMode As Boolean
-    Dim in_range As Range
-    
-    DebugMode = Worksheets(VAR_SHEET).Range("BOOL_DESIGN_MODE") = True
-
-    If DebugMode Then
-        sh.Unprotect
-    Else
-        sh.Protect DrawingObjects:=True, UserInterfaceOnly:=True
-    End If
-
-    If iset.vType = INPUT_CHECK Then
-        Set in_range = Target.Worksheet.Range(iset.rChk)
-    Else
-        Set in_range = Target
-    End If
-    
-    Dim str As String
-    str = GetFocusAddress(in_range, sh.Range("h_inputs"))
-
-'    MsgBox Target.Address & "; " & str
-    If str <> Target.address Then
-        sh.Range(str).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-Dlg_lpu_card
->>>>>>
-Attribute VB_Name = "Dlg_lpu_card"
-Attribute VB_Base = "0{137EDDE5-3DB4-4BAD-A245-324DC31ABB36}{3BD7159A-BF6C-403F-B3DF-4834FA9E4D92}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub bt_Cancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub bt_Ok_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-Private Sub cbLPU_List_Change()
-    Dim src As Range
-    Dim idx_src As Integer
-    
-    Set src = Worksheets(VAR_SHEET).Range(Me.cbLPU_List.RowSource)
-    idx_src = Me.cbLPU_List.ListIndex + 1
-    Me.tb_lpu_name.Text = src.Cells(idx_src, 1)
-    Me.tb_lpu_address.Text = src.Cells(idx_src, 2)
-    Me.tbBedsCount.Text = src.Cells(idx_src, 3)
-End Sub
-
-
-Private Sub cbxLPU_List_Enable_Click()
-    
-    If Me.cbxLPU_List_Enable Then
-        
-        Me.tb_lpu_name.Text = ""
-        Me.tb_lpu_name.Enabled = False
-        
-        Me.tb_lpu_address.Text = ""
-        Me.tb_lpu_address.Enabled = False
-        
-        Me.tbBedsCount.Text = ""
-        Me.tbBedsCount.Enabled = False
-        
-        Me.cbLPU_List.Enabled = True
-        cbLPU_List_Change
-    Else
-        Me.tb_lpu_name.Enabled = True
-        Me.tb_lpu_name.Text = ""
-        
-        Me.tb_lpu_address.Enabled = True
-        Me.tb_lpu_address.Text = ""
-        
-        Me.tbBedsCount.Enabled = True
-        Me.tbBedsCount.Text = ""
-        
-        Me.cbLPU_List.Enabled = False
-    End If
-End Sub
-
-<<<<<<
-======================
-UserInfo
->>>>>>
-Attribute VB_Name = "UserInfo"
-Attribute VB_Base = "0{8EB80D4C-3476-421A-A370-6332A07DE509}{A7542905-C9F8-4F39-AD67-B62A88F8F4E6}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Tag = vbOK
-End Sub
-
-Private Sub cbCity_Change()
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_CITY") = Me.cbCity.ListIndex
-        .Calculate
-    End With
-End Sub
-
-Private Sub cbRegion_Change()
-    Dim LinesCount, NewRangeOffsetCol As Integer
-    Dim NewCbxRange, NewSumRange As String
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        NewRangeOffsetCol = cbRegion.Value * 2
-        LinesCount = GetLinesCount(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol))
-        NewCbxRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol)).address
-        NewSumRange = .name & "!" & _
-                        .Range(.Range("CITY_TABLES").Offset(1, NewRangeOffsetCol + 1), _
-                        .Range("CITY_TABLES").Offset(LinesCount, NewRangeOffsetCol + 1)).address
-        .Calculate
-        .Range("IDX_CITY") = 0
-        cbCity.RowSource = NewCbxRange
-
-    End With
-    cbCity.ListIndex = 0
-End Sub
-
-<<<<<<
-======================
-mREP
->>>>>>
-Attribute VB_Name = "mREP"
-Option Explicit
-
-Sub hwnew()
-    Dim rs As Range
-    Dim re As Object
-    
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    HWReset
-    ReSetREPRecord
-    With Worksheets("REP_QTR")
-        .ClearRepName
-        .Range("REP_QTR_INPUT_DATA").ClearContents
-        .Range("QTR_SEL") = ""
-    End With
-    Worksheets(TITLE_SHEET).Select
-    With Application
-        .DisplayAlerts = False
-        .ThisWorkbook.Save
-        .Quit
-    End With
-End Sub
-
-Function CheckUser() As Boolean
-    Dim objHW() As Long
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    
-    GetHWInfo objHW()
-    i = GetHWRecords(objHW_DB)
-    
-    If i = 0 Then ' First time
-        StoreHWInfo objHW()
-        Worksheets("REP_QTR").Range("QTR_SEL") = ""
-    End If
-    If CheckHWInfo(objHW()) <> True Then
-        CheckUser = False
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    Else
-        CheckUser = SetupUser
-    End If
-End Function
-
-Function SetupUser() As Boolean
-    Dim cUser As tREP
-    Dim idx As Integer
-    Dim dlg_ui As UserInfo
-    
-    Set dlg_ui = New UserInfo
-    
-    cUser = GetREPRecord()
-    
-    With ThisWorkbook.Worksheets(REGS_SHEET)
-        .Range("IDX_REGION") = cUser.Region
-        .Range("IDX_CITY") = cUser.City
-    End With
-        
-    With dlg_ui
-        .cbRegion = cUser.Region
-        .cbCity = cUser.City
-        .tbFName = cUser.FirstName
-        .tbLName = cUser.LastName
-    End With
-    
-    Worksheets(REGS_SHEET).Calculate
-    
-    Dim test_Ok As Boolean
-    test_Ok = False
-    
-    On Error GoTo l1
-
-    Do
-        dlg_ui.Show
-        If dlg_ui.Tag = vbOK Then
-            test_Ok = dlg_ui.tbFName.Value <> "" And dlg_ui.tbLName <> ""
-            If test_Ok Then
-                Exit Do
-            Else
-                MsgBox "������� ��� � �������", vbOKOnly, PROGRAM_NAME
-            End If
-        Else
-            Exit Do
-        End If
-    Loop Until False
-l1:
-    If test_Ok Then
-        With cUser
-            .Region = dlg_ui.cbRegion.Value
-            .City = dlg_ui.cbCity.Value
-            .FirstName = dlg_ui.tbFName.Value
-            .LastName = dlg_ui.tbLName.Value
-        End With
-        SetREPRecord cUser
-    Else
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .ThisWorkbook.Saved = True
-            .Quit
-        End With
-    End If
-    SetupUser = test_Ok
-End Function
-
-Sub GetHWInfo(objHW() As Long)
-    Dim fs, d, dc, s, n
-    Dim r As Range
-    Dim i As Integer
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    Set dc = fs.Drives
-    i = 1
-    For Each d In dc
-        If d.drivetype = 2 Then ' 2 - HardDisk
-            ReDim Preserve objHW(i)
-            objHW(i) = d.SerialNumber
-            i = i + 1
-        End If
-    Next
-    SortHW objHW
-End Sub
-
-Sub StoreHWInfo(objHW() As Long)
-    UpdateHWRecords objHW
-End Sub
-
-Sub SortHW(objHW() As Long)
-    Dim r As Range
-    Dim rs As Range
-    Dim re As Object
-    Dim i As Integer
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).ClearContents
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    For i = 1 To UBound(objHW)
-        r = objHW(i)
-        Set r = r.Offset(1, 0)
-    Next i
-    With Worksheets(VAR_SHEET)
-        Set rs = .Range("HW_Number")
-        Set re = .Range(rs, rs.End(xlDown))
-        .Range(rs, re).Sort _
-            Key1:=.Range("HW_Number"), _
-            Order1:=xlDescending, _
-            Header:=xlGuess, _
-            OrderCustom:=1, _
-            MatchCase:=False, _
-            Orientation:=xlTopToBottom
-    End With
-    Set r = Worksheets(VAR_SHEET).Range("HW_Number")
-    i = 1
-    Do While r <> ""
-        objHW(i) = r
-        Set r = r.Offset(1, 0)
-        i = i + 1
-    Loop
-End Sub
-
-Function CheckHWInfo(objHW() As Long)
-    Dim objHW_DB() As Long
-    Dim i As Integer
-    CheckHWInfo = False
-        
-    i = GetHWRecords(objHW_DB)
-    If i > 0 Then
-        SortHW objHW_DB
-    End If
-    If UBound(objHW) = UBound(objHW_DB) Then
-        For i = 1 To UBound(objHW)
-            If objHW(i) <> objHW_DB(i) Then
-                Exit Function
-            End If
-        Next i
-        CheckHWInfo = True
-    End If
-End Function
-<<<<<<
-======================
-dbBudget
->>>>>>
-Attribute VB_Name = "dbBudget"
-Option Explicit
-
-Public Type tBUDGET
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    bdgt_NMG As Long
-    bdgt_NFG As Long
-    sale_plan As Long
-End Type
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function GetAll_BDGT_RecordsByLPU_ID(ByRef allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_BDGT_RecordsByLPU_ID = dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection, allBDGT, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Function Get_BDGT_Record(ByVal lpu_id As Long, ByVal ent_date As String) As tBUDGET
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    Get_BDGT_Record = dbGet_BDGT_Record(dbConnection, lpu_id, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objBDGT.ID <> 0 then updatre else insert
-Public Sub Insert_BDGT_Record(objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    If objBDGT.id <> 0 Then
-        dbUpdate_BDGT_Record dbConnection, objBDGT
-    Else
-        dbInsert_BDGT_Record dbConnection, objBDGT
-    End If
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Public Sub Delete_BDGT_Record(ByRef objBDGT As tBUDGET)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    dbDelete_BDGT_Record dbConnection, objBDGT
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGet_BDGT_Record(dbConnection As Object, ByVal lpu_id As Long, ent_date As String) As tBUDGET
-    
-    Dim SQL As String
-    Dim objBDGT As tBUDGET
-    
-    With objBDGT
-        .id = 0
-        .lpu_id = lpu_id
-        .entry_date = ent_date
-        .bdgt_NMG = 0
-        .bdgt_NFG = 0
-        .sale_plan = 0
-    End With
-        
-    
-    SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        With objBDGT
-            .entry_date = dbRecordset("entry_date")
-            .id = dbRecordset("id")
-            .lpu_id = dbRecordset("lpu_id")
-            .bdgt_NFG = dbRecordset("bdgt_NFG")
-            .bdgt_NMG = dbRecordset("bdgt_NMG")
-            .sale_plan = dbRecordset("sale_PLAN")
-        End With
-    End If
-    
-    dbGet_BDGT_Record = objBDGT
-End Function
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_BDGT_RecordsbyLPU_ID(dbConnection As Object, allBDGT() As tBUDGET, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_BDGT_SQL As String
-    Dim getAll_BDGT_SQL As String
-    Dim BDGT_Count As Long
-    BDGT_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_BDGT_SQL = "SELECT COUNT(*) AS BDGT_TOTAL FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_BDGT_SQL = "SELECT * FROM lpu_budget WHERE lpu_id=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_BDGT_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        BDGT_Count = dbRecordset("BDGT_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_BDGT_RecordsbyLPU_ID = BDGT_Count
-    
-    If BDGT_Count > 0 Then
-        'we have records
-        ReDim allBDGT(1 To BDGT_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_BDGT_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpBDGT As tBUDGET
-                 With tmpBDGT
-                    .entry_date = dbRecordset("entry_date")
-                    .id = dbRecordset("id")
-                    .lpu_id = dbRecordset("lpu_id")
-                    .bdgt_NFG = dbRecordset("bdgt_NFG")
-                    .bdgt_NMG = dbRecordset("bdgt_NMG")
-                    .sale_plan = dbRecordset("sale_PLAN")
-                 End With
-                 
-                 allBDGT(index) = tmpBDGT
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbInsert_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "lpu_budget", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    dbRecordset("entry_date") = objBDGT.entry_date
-    dbRecordset("lpu_id") = objBDGT.lpu_id
-    dbRecordset("bdgt_NMG") = objBDGT.bdgt_NMG
-    dbRecordset("bdgt_NFG") = objBDGT.bdgt_NFG
-    dbRecordset("sale_PLAN") = objBDGT.sale_plan
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objBDGT.id = dbRecordset("id")
-  
-End Sub
-
-Public Sub dbUpdate_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu_budget SET " & _
-    "entry_date='" & objBDGT.entry_date & "'," & _
-    "lpu_id=" & objBDGT.lpu_id & "," & _
-    "bdgt_NMG=" & objBDGT.bdgt_NMG & "," & _
-    "bdgt_NFG=" & objBDGT.bdgt_NFG & "," & _
-    "sale_PLAN=" & objBDGT.sale_plan & _
-    " WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-Public Sub dbDelete_BDGT_Record(dbConnection As Object, ByRef objBDGT As tBUDGET)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE id=" & objBDGT.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_BDGT_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_BDGT_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_budget " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbDatabase
->>>>>>
-Attribute VB_Name = "dbDatabase"
-Option Explicit
-
-
-Sub dbOpenConnection(dbConnection As Object)
-    Dim dbAccessFile As String
-    Dim dbAccessFilePasswd As String
-    
-    dbAccessFile = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dbAccessFilePasswd = "password"
-    
-    Set dbConnection = CreateObject("ADODB.Connection")
-    Dim dbConnectionString As String
-    dbConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & _
-    dbAccessFile & ";Password=" & dbAccessFilePasswd
-    
-    dbConnection.Open dbConnectionString
-    
-End Sub
-
-Sub dbCloseConnection(dbConnection As Object)
-    dbConnection.Close
-End Sub
-
-
-Sub dbExecuteSQL(dbConnection As Object, SQL As String)
-    dbConnection.Execute (SQL)
-End Sub
-
-<<<<<<
-======================
-dbLPU
->>>>>>
-Attribute VB_Name = "dbLPU"
-Option Explicit
-
-Public Type tLPU
-    id As Long
-    rep_id As Long
-    name As String
-    address As String
-    beds As Integer
-End Type
-
-Function Get_LPU_Record(ByVal lpu_id As Long) As tLPU
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    Get_LPU_Record = dbGet_LPU_Record(dbConnection, lpu_id)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPU(allLPU() As tLPU) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPU = dbGetAllLPU(dbConnection, allLPU)
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAllLPUbyQTR(allLPU() As tLPU, ent_date As String) As Integer
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetAllLPUbyQTR = dbGetAllLPUbyQTR(dbConnection, allLPU, ent_date)
-    dbCloseConnection dbConnection
-End Function
-
-' if objLPU.id = 0 then insert else update
-Sub Insert_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    If objLPU.id = 0 Then
-        dbInsert_LPU_Record dbConnection, objLPU
-    Else
-        dbUpdate_LPU_Record dbConnection, objLPU
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-
-Sub Delete_LPU_Record(ByRef objLPU As tLPU)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDelete_LPU_Record dbConnection, objLPU
-    dbCloseConnection dbConnection
-End Sub
-
-Sub Delete_LPU_RecordQTR(ByRef objLPU As tLPU, ent_date As String)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-    dbCloseConnection dbConnection
-    
-End Sub
-
-Function dbGet_LPU_Record(dbConnection As Object, ByVal lpu_id As Long) As tLPU
-    
-    Dim SQL As String
-    Dim objLPU As tLPU
-    
-    objLPU.id = lpu_id
-    objLPU.name = ""
-    objLPU.address = ""
-    
-    SQL = "SELECT * FROM lpu WHERE id=" & lpu_id
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        objLPU.name = dbRecordset("name")
-        objLPU.address = dbRecordset("address")
-        objLPU.rep_id = dbRecordset("rep_id")
-        objLPU.beds = dbRecordset("beds")
-    End If
-    
-    dbGet_LPU_Record = objLPU
-
-End Function
-
-Sub dbInsert_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-  
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu", dbConnection, 2, 2
-    dbRecordset.addnew
-    dbRecordset("name") = objLPU.name
-    dbRecordset("address") = objLPU.address
-    dbRecordset("rep_id") = objLPU.rep_id
-    dbRecordset("beds") = objLPU.beds
-    
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objLPU.id = dbRecordset("id")
-  
-End Sub
-
-Sub dbUpdate_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim UpdateSQL As String
-    
-    UpdateSQL = "UPDATE lpu SET " & _
-    "name='" & objLPU.name & "'," & _
-    "address='" & objLPU.address & "'," & _
-    "beds=" & objLPU.beds & "," & _
-    "rep_id=" & objLPU.rep_id& & _
-    " WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-       
-End Sub
-
-
-Function dbGetAllLPU(dbConnection As Object, allLPU() As tLPU) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu"
-    getAll_LPU_SQL = "SELECT * FROM lpu"
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPU = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Function dbGetAllLPUbyQTR(dbConnection As Object, allLPU() As tLPU, ent_date As String) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_LPU_SQL As String
-    Dim lpu_count As Long
-    lpu_count = 0
-    
-    Dim where As String
-    where = "WHERE lpu_budget.entry_date like '" & ent_date & "'"
-    
-    getCount_SQL = "SELECT COUNT(*) AS LPU_TOTAL FROM lpu_budget " & where
-    
-    getAll_LPU_SQL = "SELECT lpu.id as id, lpu.rep_id as rep_id, lpu.name as name, lpu.address as address, lpu.beds AS beds " & _
-    "FROM lpu, lpu_budget " & where & " AND lpu.id=lpu_budget.lpu_id"
-    
-
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        lpu_count = dbRecordset("LPU_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAllLPUbyQTR = lpu_count
-    
-    If lpu_count > 0 Then
-        'we have records
-        ReDim allLPU(1 To lpu_count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_LPU_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                 Dim tmpLPU As tLPU
-                 
-                 With tmpLPU
-                    .id = dbRecordset("id")
-                    .name = dbRecordset("name")
-                    .address = dbRecordset("address")
-                    .rep_id = dbRecordset("rep_id")
-                    .beds = dbRecordset("beds")
-                 End With
-                 
-                 allLPU(index) = tmpLPU
-                 index = index + 1
-                 dbRecordset.MoveNext
-                 
-             Loop
-        End If
-    End If
-End Function
-
-Sub dbDelete_LPU_Record(dbConnection As Object, ByRef objLPU As tLPU)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu " & _
-    "WHERE id=" & objLPU.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Hir_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_Ter_RecordsByLPU_ID dbConnection, objLPU.id
-    dbDelete_ACS_RecordsByLPU_ID dbConnection, objLPU.id
-    
-End Sub
-
-Sub dbDelete_LPU_RecordQTR(dbConnection As Object, ByRef objLPU As tLPU, ent_date As String)
-    
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Hir_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_Ter_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    dbDelete_ACS_RecordsByQTR_LPU dbConnection, objLPU.id, ent_date
-    
-End Sub
-
-<<<<<<
-======================
-dbREP
->>>>>>
-Attribute VB_Name = "dbREP"
-Option Explicit
-
-Public Type tREP
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Function GetREPRecord() As tREP
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    GetREPRecord = dbGetREPRecord(dbConnection)
-    dbCloseConnection dbConnection
-End Function
-
-Sub SetREPRecord(cUser As tREP)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbSetREPRecord dbConnection, cUser
-    dbCloseConnection dbConnection
-End Sub
-
-Sub ReSetREPRecord()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbReSetREPRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Public Function dbGetREPRecord(dbConnection As Object) As tREP
-    
-    Dim SQL As String
-    Dim objREP As tREP
-    
-    objREP.FirstName = ""
-    objREP.LastName = ""
-    objREP.Region = 0
-    objREP.City = 0
-    SQL = "SELECT firstname, lastname, region, city FROM " & _
-          "rep"
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open SQL, dbConnection
-    ', 3, 3
-    If Not dbRecordset.BOF Then
-        
-        objREP.FirstName = dbRecordset("firstname")
-        objREP.LastName = dbRecordset("lastname")
-        objREP.Region = dbRecordset("region")
-        objREP.City = dbRecordset("city")
-        
-    End If
-    
-    dbGetREPRecord = objREP
-        
-End Function
-
-Public Sub dbSetREPRecord(dbConnection As Object, ByRef objREP As tREP)
-  
-    Dim DeleteSQL As String
-    Dim InsertSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    InsertSQL = "INSERT INTO rep (firstname, lastname, region, city) VALUES (" & _
-    "'" & objREP.FirstName & "', " & _
-    "'" & objREP.LastName & "', " & _
-    objREP.Region & ", " & _
-    objREP.City & ")"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-    dbRecordset.Open InsertSQL, dbConnection
-End Sub
-
-Public Sub dbReSetREPRecord(dbConnection As Object)
-  
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM rep"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-
-<<<<<<
-======================
-cAppEvents
->>>>>>
-Attribute VB_Name = "cAppEvents"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Public WithEvents app As Application
-Attribute app.VB_VarHelpID = -1
-
-Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
-    CheckWorkBooksArround Wb
-End Sub
-
-
-Sub CheckWorkBooksArround(ByVal Wb As Workbook)
-    Dim wbname As String
-    Dim rslt As Integer
-    Dim wbk As Workbook
-    If app.Workbooks.Count > 1 Then
-        wbname = ThisWorkbook.FullName
-        rslt = MsgBox("��� �������� ����� EXCEl ������ ����� �������!", vbOKOnly, "&" + PROGRAM_NAME)
-        If rslt = vbOK Then
-            For Each wbk In Workbooks
-                If wbk.FullName <> wbname Then
-                    wbk.Close
-                End If
-            Next wbk
-        Else
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-        Exit Sub
-    End If
-
-End Sub
-<<<<<<
-======================
-cApplicationState
->>>>>>
-Attribute VB_Name = "cApplicationState"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-'----------------------------------------
-' This class stores and restores the state
-' of the Excel application
-'----------------------------------------
-
-Private Type COMMANDBAR_STATE
-    sName As String
-    bVisible As Boolean
-End Type
-
-Dim m_atCommandBars() As COMMANDBAR_STATE
-Dim m_nCalculation As Integer
-Dim m_bCellDragAndDrop As Boolean
-Dim m_bDisplayFormulaBar As Boolean
-Dim m_bDisplayNoteIndicator As Boolean
-Dim m_bDisplayStatusBar As Boolean
-Dim m_bEditDirectlyInCell As Boolean
-Dim m_bTransitionNavigationKeys As Boolean
-Dim m_bPlayASound As Boolean
-
-
-Public Sub SaveExcelState()
-'----------------------------------------
-' save the current state in member variables
-'----------------------------------------
-
-    Dim objCommandBar As CommandBar
-    Dim nCtr As Integer
-    
-    With Application
-    
-        ' save calculation mode - note: a workbook must be
-        ' open or the Calculation property fails so we
-        ' open a new workbook here just to be safe
-        .ScreenUpdating = False
-        .Workbooks.Add
-        m_nCalculation = .Calculation
-        .Calculation = xlCalculationAutomatic
-        ActiveWorkbook.Close False
-        ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes
-        
-        m_bCellDragAndDrop = .CellDragAndDrop
-        m_bDisplayFormulaBar = .DisplayFormulaBar
-        m_bDisplayNoteIndicator = .DisplayNoteIndicator
-        m_bDisplayStatusBar = .DisplayStatusBar
-        m_bEditDirectlyInCell = .EditDirectlyInCell
-        m_bTransitionNavigationKeys = .TransitionNavigKeys
-        m_bPlayASound = .EnableSound
-        
-
-        ' save visibility of each commandbar
-        ReDim m_atCommandBars(.CommandBars.Count - 1)
-        nCtr = 0
-        For Each objCommandBar In .CommandBars
-            With m_atCommandBars(nCtr)
-                .sName = objCommandBar.name
-                .bVisible = objCommandBar.Visible
-            End With
-            nCtr = nCtr + 1
-        Next objCommandBar
-        
-    End With
-
-End Sub
-
-Public Sub HideAllCommandBars()
-'----------------------------------------
-' hides all command bars
-'----------------------------------------
-    Dim objCommandBar As CommandBar
-    On Error Resume Next
-    For Each objCommandBar In Application.CommandBars
-        objCommandBar.Visible = False
-        objCommandBar.Protection = msoBarNoChangeVisible
-    Next objCommandBar
-    Application.CommandBars(STDBAR_NAME).Visible = False
-End Sub
-
-
-Public Sub RestoreExcelState()
-'----------------------------------------
-' restores the state as saved by GetState
-'----------------------------------------
-    Dim nCtr As Integer
-    
-    On Error Resume Next
-    
-    With Application
-        .ScreenUpdating = False
-        .CellDragAndDrop = m_bCellDragAndDrop
-        .DisplayFormulaBar = m_bDisplayFormulaBar
-        .DisplayNoteIndicator = m_bDisplayNoteIndicator
-        .DisplayStatusBar = m_bDisplayStatusBar
-        .EditDirectlyInCell = m_bEditDirectlyInCell
-        .TransitionNavigKeys = m_bTransitionNavigationKeys
-        .EnableSound = m_bPlayASound
-        
-        
-        .Workbooks.Add
-        .Calculation = m_nCalculation
-        ActiveWorkbook.Close False
-
-    End With
-
-    For nCtr = 0 To UBound(m_atCommandBars)
-        With m_atCommandBars(nCtr)
-            Application.CommandBars(.sName).Protection = msoBarNoProtection
-            Application.CommandBars(.sName).Visible = .bVisible
-        End With
-    Next nCtr
-    Application.CommandBars(STDBAR_NAME).Visible = True
-End Sub
-
-<<<<<<
-======================
-cEnableRun
->>>>>>
-Attribute VB_Name = "cEnableRun"
-Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-' use notation YYYYMMDD for definition estimation date like as 19980827
-' if end_date = -1 then not estimation checked
-
-Public Sub EnableRun(end_date As Long, ByVal theDate As Date)
-    
-    If end_date = NO_ESTIMATION_DATE Then
-        Exit Sub
-    End If
-    Dim day, month, year As Long
-    Dim CurDate As Long
-    day = DatePart("d", theDate)
-    month = DatePart("m", theDate)
-    year = DatePart("yyyy", theDate)
-    CurDate = year * 10000
-    CurDate = CurDate + month * 100
-    CurDate = CurDate + day
-    If CurDate > end_date Then
-        cmAbout
-        With Application
-            .DisplayAlerts = False
-            .Quit
-        End With
-    End If
-End Sub
-
-<<<<<<
-======================
-mMenu
->>>>>>
-Attribute VB_Name = "mMenu"
-Option Explicit
-
-Public Const STDBAR_NAME = "Worksheet Menu Bar"
-
-Sub CreateCommandBar(theApp As Application)
-'----------------------------------------
-' creates this application's custom commandbar
-'----------------------------------------
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar theApp
-    With theApp.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlPopup)
-                .Caption = "&File"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Export"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 620
-                        .OnAction = "cmExport"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "E&xit"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 330
-                        .OnAction = "cmCloseProgram"
-                    End With
-                End With
-            End With
-            With .Add(msoControlPopup)
-                .Caption = "&Help"
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Mail to Support"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 328
-                        .OnAction = "cmMail2Support"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&Exit && Restore Excel"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 548
-                        .OnAction = "cmExitRestore"
-                    End With
-                End With
-                With .Controls
-                    With .Add(msoControlButton)
-                        .Caption = "&About"
-                        .Style = msoButtonIconAndCaption
-                        .FaceId = 51
-                        .OnAction = "cmAbout"
-                    End With
-                End With
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Start Page"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 1016
-                .OnAction = "cmHomePage"
-            End With
-        End With
-    End With
-End Sub
-
-Sub DeleteCommandBar(theApp As Application)
-'----------------------------------------
-' deletes this application's custom commandbar
-'----------------------------------------
-    On Error Resume Next
-    With theApp.CommandBars(COMMANDBAR_NAME)
-        .Protection = msoBarNoProtection
-        .Delete
-    End With
-End Sub
-
-Sub SetNewMode()
-Attribute SetNewMode.VB_ProcData.VB_Invoke_Func = "I\n14"
-    Dim MenuBarBool As Boolean
-    
-    MenuBarBool = True
-
-    DeleteCommandBar Application
-    With Application.CommandBars.Add(COMMANDBAR_NAME, msoBarTop, MenuBarBool, True)
-        .Visible = True
-        .Visible = True
-        .Position = msoBarTop
-        .Protection = msoBarNoChangeVisible _
-                    + msoBarNoCustomize _
-                    + msoBarNoMove _
-                    + msoBarNoChangeDock
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "E&xit"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 3
-                .OnAction = "cmCloseProgram"
-            End With
-            With .Add(msoControlButton)
-                .Caption = "&Edit Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 44
-                .OnAction = "cmSetDesignerMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub SetupDesignMenu(flag As Boolean)
-    If flag = False Then
-        Exit Sub
-    End If
-    
-    With Application.CommandBars(STDBAR_NAME)
-        .Reset
-        With .Controls
-            With .Add(msoControlButton)
-                .Caption = "&Run Application"
-                .Style = msoButtonIconAndCaption
-                .FaceId = 51
-                .OnAction = "cmSetStandaloneMode"
-            End With
-        End With
-    End With
-End Sub
-
-Sub cmExport()
-    dbExport
-End Sub
-
-Sub cmCloseProgram()
-    Application.Quit
-End Sub
-
-Sub cmAbout()
-    Dim dlg As dlgAbout
-    Set dlg = New dlgAbout
-    
-    dlg.ProgName = PROGRAM_NAME
-    If ESTIMATION_DATE <> NO_ESTIMATION_DATE Then
-        dlg.ProgVersion = "TRIAL " & PROGRAM_VERSION
-    Else
-        dlg.ProgVersion = PROGRAM_VERSION & " RELEASE"
-    End If
-    dlg.Show
-End Sub
-
-Sub cmMail2Support()
-    Dim err_description As String
-    Dim dlg_msg As dlg_Mail
-    Set dlg_msg = New dlg_Mail
-    With dlg_msg
-        .Show
-        If .Tag = vbOK Then
-            ThisWorkbook.Worksheets(VAR_SHEET).Range("ERR_MESSAGE") _
-                = .tbMessage.Text
-            ThisWorkbook.Save
-            ThisWorkbook.SendMail Recipients:="infra@i-rs.ru", Subject:=PROGRAM_NAME & " ver.:" & PROGRAM_VERSION
-            MsgBox "��������� �� ������ ����������. ������������� ���������.", vbOKOnly, PROGRAM_NAME
-            ThisWorkbook.Close SaveChanges:=False
-        End If
-    End With
-End Sub
-
-Sub cmHelpContents()
-    Dim helppath As String
-    With ThisWorkbook
-'        helppath = "hh.exe " & .Path & "\Telfast.chm"
-'        Shell helppath, vbNormalFocus
-    End With
-End Sub
-
-Sub set_work_mode()
-    Application.ScreenUpdating = False
-    ProtectionDisable Wb:=ThisWorkbook
-    SetupEnvironment Wb:=ThisWorkbook
-    SetDesignFlagOff
-    ProtectionEnable Wb:=ThisWorkbook
-End Sub
-
-Sub cmSetStandaloneMode()
-    set_work_mode
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Select
-End Sub
-
-Sub cmSetDesignerMode()
-    Dim rp As String
-    Dim dlg As dlgGetPwd
-    rp = common_pwd
-    
-    Set dlg = New dlgGetPwd
-    dlg.edPwd = ""
-    dlg.Show
-    
-    If dlg.edPwd = rp Then
-        ProtectionDisable Wb:=ThisWorkbook
-        RestoreEnvironment Wb:=ThisWorkbook, DesignMode:=True
-        SetDesignFlagOn
-        ThisWorkbook.Worksheets(TITLE_SHEET).Select
-    Else
-        cmSetStandaloneMode
-    End If
-End Sub
-
-Sub cmHomePage()
-    ThisWorkbook.Worksheets("REP_QTR").Select
-End Sub
-
-Sub cmExitRestore()
-    ThisWorkbook.Worksheets(VAR_SHEET).Range("BOOL_EXIT_RESTORE") = True
-    Application.Quit
-End Sub
-<<<<<<
-======================
-mPrint
->>>>>>
-Attribute VB_Name = "mPrint"
-Option Explicit
-
-Type Print_Options
-    MainReport As Boolean
-    MainBudget As Boolean
-    SrcData As Boolean
-    AllSheets As Boolean
-End Type
-
-Sub cmPrint()
-    Dim plist As Variant
-    Dim dlg_prn As dlgPrint
-    
-    Set dlg_prn = New dlgPrint
-    
-    With dlg_prn
-        .cbMainReport = True
-        .cbMainBudget = False
-        .cbSrcData = False
-        .cbAllSheets = False
-    
-        .Show
-    
-        If .Tag = vbCancel Then
-            Exit Sub
-        End If
-    End With
-    
-    Dim PrnIdx As Integer
-    
-    With dlg_prn
-        PrnIdx = Abs(.cbMainReport _
-                + .cbMainBudget * 10 _
-                + .cbSrcData * 100 _
-                + .cbAllSheets * 1000)
-    End With
-    
-    Select Case PrnIdx
-    Case 1
-        plist = Array("Final")
-    Case 11
-        plist = Array("budget", "Final")
-    Case 111
-        plist = Array("REP_QTR", "budget", "Final")
-    Case 1111
-        plist = Array("REP_QTR", "budget", "Final", _
-                        "Doc", "Doc.Visit", "Doc.Conf", _
-                        "Apt", "Apt.Visit", "Apt.Conf", _
-                        "Adv", "Act", "Cost")
-    End Select
-    
-    Application.ScreenUpdating = False
-    Dim ws As Worksheet
-    Dim lh As String
-    With Sheets("REP_QTR")
-        lh = .Range("USER_NAME_S") & " " & .Range("USER_NAME_F")
-    End With
-    With Sheets("data")
-        lh = lh & ", " & .Range("LST_PERSONE").Cells(.Range("IDX_PERSONE"))
-        lh = lh & ", " & .Range("LST_REGIONS").Cells(.Range("IDX_REGION"))
-        lh = lh & ", " & .Range("CITY_TABLES").Offset(.Range("IDX_CITY"), (.Range("IDX_REGION") - 1) * 2)
-End With
-        
-    For Each ws In Worksheets(plist)
-        With ws.PageSetup
-            .LeftHeader = lh
-            .CenterHeader = ""
-            .RightHeader = "&D"
-'            .LeftFooter =
-            .CenterFooter = PROGRAM_NAME
-            .RightFooter = "Page &P of &N"
-        End With
-    Next ws
-    Worksheets(plist).PrintOut Copies:=1, Collate:=True
-    Application.ScreenUpdating = False
-    
-End Sub
-
-
-<<<<<<
-======================
-mStartup
->>>>>>
-Attribute VB_Name = "mStartup"
-Option Explicit
-
-'----------------------------------------
-' define instance of object which will
-' store the initial state of excel
-'----------------------------------------
-Dim mobjAppState As New cApplicationState
-
-
-'----------------------------------------
-' constant definitions
-'----------------------------------------
-Public Const COMMANDBAR_NAME = "Clexane bar"
-Public Const common_pwd As String = "crdjhxtyjr"
-
-
-Sub SetupEnvironment(Wb As Workbook)
-'----------------------------------------
-' Saves the current state of Excel then
-' prepares the environment for this application
-'----------------------------------------
-    
-    Wb.Worksheets(TITLE_SHEET).Select
-    With Application
-        .Caption = PROGRAM_NAME & " " & PROGRAM_VERSION
-        .ScreenUpdating = False
-    End With
-    With mobjAppState
-        .SaveExcelState
-        .HideAllCommandBars
-    End With
-    With Application
-        .DisplayFormulaBar = False
-        .DisplayStatusBar = True
-        .EnableSound = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = False
-    End With
-    With Wb
-        With .Windows(1)
-            .Caption = ""
-            .DisplayHorizontalScrollBar = False
-            .DisplayVerticalScrollBar = False
-            .DisplayWorkbookTabs = False
-            .WindowState = xlMaximized
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    With cWindow
-                        .DisplayHeadings = False
-                        .ScrollRow = 1
-                        .ScrollColumn = 1
-                    End With
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-    End With
-    CreateCommandBar theApp:=Wb.Application
-End Sub
-
-Sub RestoreEnvironment(Wb As Workbook, Optional DesignMode As Boolean)
-'----------------------------------------
-' Restores Excel to its intial state when
-' this application started
-'----------------------------------------
-    Wb.Worksheets(TITLE_SHEET).Select
-    Application.ScreenUpdating = False
-    With Wb
-        With .Windows(1)
-            .DisplayHorizontalScrollBar = True
-            .DisplayVerticalScrollBar = True
-            .DisplayWorkbookTabs = True
-        End With
-        Dim cWorkSheet As Worksheet
-        For Each cWorkSheet In .Worksheets
-            If cWorkSheet.Visible = xlSheetVisible Then
-'                cWorkSheet.Select
-                Dim cWindow As Window
-                For Each cWindow In Application.Windows
-                    If cWindow.Type = xlWorkbook Then
-                        cWindow.DisplayHeadings = True
-                    End If
-                Next
-            End If
-        Next
-        .Worksheets(TITLE_SHEET).Select
-        If DesignMode Then
-            SetupDesignMenu True
-        End If
-        With mobjAppState
-            .RestoreExcelState
-        End With
-    End With
-    DeleteCommandBar theApp:=Application
-End Sub
-
-Sub ProtectionEnable(Wb As Workbook)
-    With Wb
-        .Application.ScreenUpdating = False
-        .Protect Windows:=True
-        .Worksheets(TITLE_SHEET).Select
-'        .Activate
-    End With
-End Sub
-
-Sub ProtectionDisable(Wb As Workbook)
-    With Wb
-        .Unprotect
-    End With
-End Sub
-
-
-
-<<<<<<
-======================
-dbHW
->>>>>>
-Attribute VB_Name = "dbHW"
-Option Explicit
-
-Sub UpdateHWRecords(objHW() As Long)
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    dbUpdateHWRecords dbConnection, objHW
-    dbCloseConnection dbConnection
-End Sub
-
-Function GetHWRecords(objHW() As Long) As Integer
-    Dim dbConnection  As Object
-    
-    dbOpenConnection dbConnection
-    GetHWRecords = dbGetHWRecords(dbConnection, objHW)
-    dbCloseConnection dbConnection
-End Function
-
-Sub HWReset()
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    dbDeleteHWRecord dbConnection
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbInsertHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    
-    Dim dbRecordset As Object
-    Dim i As Long
-    
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-
-    dbRecordset.Open "hw", dbConnection, 2, 2
-    
-    For i = 1 To UBound(objHW)
-        dbRecordset.addnew
-        dbRecordset("num") = objHW(i)
-        dbRecordset.Update
-    Next i
-    
-End Sub
-
-Sub dbUpdateHWRecords(dbConnection As Object, ByRef objHW() As Long)
-    dbDeleteHWRecord dbConnection
-    dbInsertHWRecords dbConnection, objHW
-End Sub
-
-Sub dbDeleteHWRecord(dbConnection As Object)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM hw "
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-End Sub
-
-Function dbGetHWRecords(dbConnection As Object, ByRef objHW() As Long) As Integer
-    
-    Dim getCount_SQL As String
-    Dim getAll_HW_SQL As String
-    Dim HW_Count As Long
-    
-    getCount_SQL = "SELECT COUNT(*) AS HW_TOTAL FROM hw"
-    getAll_HW_SQL = "SELECT * FROM hw"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        HW_Count = dbRecordset("HW_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetHWRecords = HW_Count
-    
-    If HW_Count > 0 Then
-        'we have records
-        ReDim objHW(HW_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_HW_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             
-             Do While Not dbRecordset.EOF
-                 
-                Dim tmp As Long
-                 
-                tmp = dbRecordset("num")
-                 
-                 objHW(index) = tmp
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-<<<<<<
-======================
-dbHir
->>>>>>
-Attribute VB_Name = "dbHir"
-Option Explicit
-
-Public Type tHIRURGIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    operations_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_ambulator_clexan_40mg As Integer
-    patients_ambulator_clexan_20mg As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-    patients_stationar_clexan_40mg As Integer
-    patients_stationar_clexan_20mg As Integer
-End Type
-
-' if objHir.ID <> 0 then updatre else insert
-Sub Insert_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objHir.id <> 0 Then
-        dbUpdate_Hir_Record dbConnection, objHir
-    Else
-        dbInsert_Hir_Record dbConnection, objHir
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Hir_RecordsByLPU_ID(ByRef allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Hir_RecordsByLPU_ID = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, allHir, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Hir_Record(ByRef objHir As tHIRURGIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Hir_Record dbConnection, objHir
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objHir.ID <> 0 then updatre else insert
-
-Sub dbInsert_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_hir", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objHir
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("operations_per_quarter") = .operations_per_quarter
-        dbRecordset("risk_percent") = .risk_percent
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_ambulator_clexan_20mg") = .patients_ambulator_clexan_20mg
-        dbRecordset("patients_ambulator_clexan_40mg") = .patients_ambulator_clexan_40mg
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-        dbRecordset("patients_stationar_clexan_20mg") = .patients_stationar_clexan_20mg
-        dbRecordset("patients_stationar_clexan_40mg") = .patients_stationar_clexan_40mg
-        
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objHir.id = dbRecordset("ID")
-
-End Sub
-
-Sub dbUpdate_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    Dim UpdateSQL As String
-    
-    With objHir
-        UpdateSQL = "UPDATE lpu_hir SET " & _
-            "entry_date='" & objHir.entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "operations_per_quarter=" & .operations_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_ambulator_clexan_20mg=" & .patients_ambulator_clexan_20mg & "," & _
-            "patients_ambulator_clexan_40mg=" & .patients_ambulator_clexan_40mg & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & "," & _
-            "patients_stationar_clexan_20mg=" & .patients_stationar_clexan_20mg & "," & _
-            "patients_stationar_clexan_40mg=" & .patients_stationar_clexan_40mg & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open UpdateSQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function dbGetAll_Hir_RecordsbyLPU_ID(dbConnection As Object, allHir() As tHIRURGIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Hir_SQL As String
-    Dim getAll_Hir_SQL As String
-    Dim Hir_Count As Long
-    Hir_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Hir_SQL = "SELECT COUNT(*) AS HIR_TOTAL FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Hir_SQL = "SELECT * FROM lpu_hir WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Hir_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Hir_Count = dbRecordset("HIR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Hir_RecordsbyLPU_ID = Hir_Count
-    
-    If Hir_Count > 0 Then
-        'we have records
-        ReDim allHir(1 To Hir_Count)
-        Dim index As Integer
-        index = 1
-        dbRecordset.Open getAll_Hir_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpHir As tHIRURGIA
-                 With tmpHir
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .operations_per_quarter = dbRecordset("operations_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_ambulator_clexan_20mg = dbRecordset("patients_ambulator_clexan_20mg")
-                    .patients_ambulator_clexan_40mg = dbRecordset("patients_ambulator_clexan_40mg")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                    .patients_stationar_clexan_20mg = dbRecordset("patients_stationar_clexan_20mg")
-                    .patients_stationar_clexan_40mg = dbRecordset("patients_stationar_clexan_40mg")
-                 End With
-                 
-                 allHir(index) = tmpHir
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Hir_Record(dbConnection As Object, ByRef objHir As tHIRURGIA)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE ID=" & objHir.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Hir_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Hir_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_hir " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-dbTer
->>>>>>
-Attribute VB_Name = "dbTer"
-Option Explicit
-
-Public Type tTERAPIA
-    id As Long
-    entry_date As String
-    lpu_id As Long
-    patients_per_quarter As Integer
-    risk_percent As Single
-    patients_with_risk_ON As Integer
-    patients_ambulator As Integer
-    patients_ambulator_nmg As Integer
-    patients_ambulator_clexan As Integer
-    patients_stationar_nmg As Integer
-    patients_stationar_clexan As Integer
-End Type
-
-' if objTer.ID <> 0 then updatre else insert
-Sub Insert_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objTer.id <> 0 Then
-        dbUpdate_Ter_Record dbConnection, objTer
-    Else
-        dbInsert_Ter_Record dbConnection, objTer
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-Function GetAll_Ter_RecordsByLPU_ID(ByRef allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_Ter_RecordsByLPU_ID = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, allTer, lpu_id, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_Ter_Record(ByRef objTer As tTERAPIA)
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_Ter_Record dbConnection, objTer
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objTer.ID <> 0 then updatre else insert
-
-Sub dbInsert_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "lpu_ter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objTer
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("LPU_ID") = .lpu_id
-        dbRecordset("patients_per_quarter") = .patients_per_quarter
-        dbRecordset("risk_percent") = Double2Str(.risk_percent, 3)
-        dbRecordset("patients_with_risk_ON") = .patients_with_risk_ON
-        dbRecordset("patients_ambulator") = .patients_ambulator
-        dbRecordset("patients_ambulator_nmg") = .patients_ambulator_nmg
-        dbRecordset("patients_ambulator_clexan") = .patients_ambulator_clexan
-        dbRecordset("patients_stationar_nmg") = .patients_stationar_nmg
-        dbRecordset("patients_stationar_clexan") = .patients_stationar_clexan
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objTer.id = dbRecordset("ID")
-
-End Sub
-
-Sub test()
-    Dim s As String
-    Dim d As Single
-    d = 1235.6789
-    s = Format(d, "####0,00")
-    MsgBox s
-End Sub
-
-Sub dbUpdate_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    Dim Update_SQL As String
-    
-    With objTer
-        Update_SQL = "UPDATE lpu_ter SET " & _
-            "entry_date='" & .entry_date & "'," & _
-            "LPU_ID=" & .lpu_id & "," & _
-            "patients_per_quarter=" & .patients_per_quarter & "," & _
-            "risk_percent=" & Double2Str(.risk_percent, 3) & "," & _
-            "patients_with_risk_ON=" & .patients_with_risk_ON & "," & _
-            "patients_ambulator=" & .patients_ambulator & "," & _
-            "patients_ambulator_nmg=" & .patients_ambulator_nmg & "," & _
-            "patients_ambulator_clexan=" & .patients_ambulator_clexan & "," & _
-            "patients_stationar_nmg=" & .patients_stationar_nmg & "," & _
-            "patients_stationar_clexan=" & .patients_stationar_clexan & _
-            " WHERE ID=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if LPU_ID = -1 then return all records for any LPU
-' if ent_date = "%" then return all records for any ent_date
-
-Function dbGetAll_Ter_RecordsbyLPU_ID(dbConnection As Object, allTer() As tTERAPIA, lpu_id As Long, ent_date As String) As Integer
-    
-    Dim getCount_Ter_SQL As String
-    Dim getAll_Ter_SQL As String
-    Dim Ter_Count As Long
-    Ter_Count = 0
-    
-    If lpu_id = -1 Then
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE entry_date like '" & ent_date & "'"
-    Else
-        getCount_Ter_SQL = "SELECT COUNT(*) AS TER_TOTAL FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-        getAll_Ter_SQL = "SELECT * FROM lpu_ter WHERE LPU_ID=" & lpu_id & " AND entry_date like '" & ent_date & "'"
-    End If
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_Ter_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        Ter_Count = dbRecordset("TER_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_Ter_RecordsbyLPU_ID = Ter_Count
-    
-    If Ter_Count > 0 Then
-        'we have records
-        ReDim allTer(1 To Ter_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_Ter_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmpTer As tTERAPIA
-                 With tmpTer
-                    .entry_date = dbRecordset("entry_date")
-                    .lpu_id = dbRecordset("LPU_ID")
-                    .id = dbRecordset("ID")
-                    .patients_per_quarter = dbRecordset("patients_per_quarter")
-                    .risk_percent = dbRecordset("risk_percent")
-                    .patients_with_risk_ON = dbRecordset("patients_with_risk_ON")
-                    .patients_ambulator = dbRecordset("patients_ambulator")
-                    .patients_ambulator_nmg = dbRecordset("patients_ambulator_nmg")
-                    .patients_ambulator_clexan = dbRecordset("patients_ambulator_clexan")
-                    .patients_stationar_nmg = dbRecordset("patients_stationar_nmg")
-                    .patients_stationar_clexan = dbRecordset("patients_stationar_clexan")
-                 End With
-                 
-                 allTer(index) = tmpTer
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_Ter_Record(dbConnection As Object, ByRef objTer As tTERAPIA)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE ID=" & objTer.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByLPU_ID(dbConnection As Object, ByVal lpu_id As Long)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM lpu_ter " & _
-    "WHERE LPU_ID=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-End Sub
-
-' Called from dbLPU
-Public Sub dbDelete_Ter_RecordsByQTR_LPU(dbConnection As Object, lpu_id As Long, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "' AND lpu_id=" & lpu_id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-' Called from dbQTR
-Public Sub dbDelete_Ter_RecordsByQTR(dbConnection As Object, ByVal ent_date As String)
-    
-    Dim DeleteSQL As String
-    
-    DeleteSQL = "DELETE FROM lpu_ter " & _
-    "WHERE entry_date='" & ent_date & "'"
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open DeleteSQL, dbConnection
-       
-End Sub
-
-
-<<<<<<
-======================
-mLPU_LIST
->>>>>>
-Attribute VB_Name = "mLPU_LIST"
-Option Explicit
-
-Public Const CINP_AREA As String = "B12"
-Public Const CLPU_NAME As Integer = 0
-Public Const CLPU_NAME1 As Integer = 1
-Public Const CLPU_NAME2 As Integer = 2
-Public Const CLPU_ID As Integer = 3
-Public Const CLPU_BEDS As Integer = 4
-Public Const CLPU_NFG As Integer = 5
-Public Const CLPU_NMG As Integer = 6
-Public Const CLPU_HIR As Integer = 7
-Public Const CLPU_TER As Integer = 8
-Public Const CLPU_CAR As Integer = 9
-Public Const CLPU_FACT As Integer = 10
-Public Const CLPU_PLAN As Integer = 11
-Public Const CLPU_PAT_LPU As Integer = 16
-Public Const CLPU_BDGT As Integer = 17
-Public Const CLPU_PAT_ALL As Integer = 16
-
-
-
-Sub EditLPU(cLPU As tLPU, ent_date As String)
-    Dim del_request As Integer
-    Dim allLPU() As tLPU
-    Dim lpu_count As Integer
-    Dim i As Integer
-    Dim tmp_LPU_List As Range
-    Dim tmp_LPU_List_Addr As String
-    Dim r_end As Range
-    Dim dlg As Dlg_lpu_card
-    
-    Set dlg = New Dlg_lpu_card
-    
-    lpu_count = GetAllLPU(allLPU)
-    With Worksheets(VAR_SHEET)
-        Set tmp_LPU_List = .Range("tmp_LPU_List")
-        Set r_end = .Range(tmp_LPU_List, tmp_LPU_List.End(xlDown))
-        Set r_end = .Range(r_end, r_end.End(xlToRight))
-        .Range(tmp_LPU_List, r_end).ClearContents
-    End With
-        
-    If lpu_count <> 0 Then
-        dlg.cbxLPU_List_Enable.Enabled = True
-        For i = 1 To UBound(allLPU)
-            tmp_LPU_List.Cells(i, 1) = allLPU(i).name
-            tmp_LPU_List.Cells(i, 2) = allLPU(i).address
-            tmp_LPU_List.Cells(i, 3) = allLPU(i).beds
-            tmp_LPU_List.Cells(i, 4) = allLPU(i).id
-        Next i
-    Else
-        dlg.cbxLPU_List_Enable.Enabled = False
-    End If
-    
-    tmp_LPU_List_Addr = Worksheets(VAR_SHEET).name & "!" & _
-            Worksheets(VAR_SHEET).Range(tmp_LPU_List, tmp_LPU_List.End(xlDown)).address
-
-    With dlg
-        .cbLPU_List.RowSource = tmp_LPU_List_Addr
-        .cbLPU_List.ListIndex = 0
-        .cbxLPU_List_Enable = False
-        .cbLPU_List.Enabled = False
-        If cLPU.id <> 0 Then
-            .cbxLPU_List_Enable.Enabled = False
-        Else
-            If lpu_count <> 0 Then
-                .cbxLPU_List_Enable.Enabled = True
-            Else
-                .cbxLPU_List_Enable.Enabled = False
-            End If
-        End If
-        .tb_lpu_name.Text = cLPU.name
-        .tb_lpu_address.Text = cLPU.address
-        .tbBedsCount = cLPU.beds
-
-        .Tag = vbCancel
-    End With
-    
-    dlg.Show
-    
-    If Not IsNumeric(dlg.Tag) Then
-        Exit Sub
-    End If
-    
-    If dlg.Tag = vbOK Then
-        Dim n As Variant
-        Dim test As Integer
-        test = 0
-        n = dlg.tbBedsCount.Value
-        If Not IsNumeric(n) Then
-            test = 1
-        Else
-            If n = 0 Then
-                test = 1
-            End If
-        End If
-        If test = 0 Then
-            
-            cLPU.name = dlg.tb_lpu_name.Text
-            cLPU.address = dlg.tb_lpu_address.Text
-            cLPU.beds = dlg.tbBedsCount.Value
-                                    
-            If cLPU.name = "" Or cLPU.address = "" Then
-                test = 2
-            End If
-        End If
-        Select Case test
-            Case 0
-                If dlg.cbxLPU_List_Enable.Value = True Then
-                    cLPU.id = tmp_LPU_List.Cells(dlg.cbLPU_List.ListIndex + 1, 4)
-                End If
-                Insert_LPU_Record cLPU
-                ' ��������� ������� ������ ��� ��� � ��������
-                Dim bdgt As tBUDGET
-                bdgt = Get_BDGT_Record(cLPU.id, ent_date)
-                ' ������ ���: ������� ������ ������ � lpu_budget
-                If bdgt.id = 0 Then
-                    bdgt.lpu_id = cLPU.id
-                    bdgt.entry_date = ent_date
-                    Insert_BDGT_Record bdgt
-                End If
-            Case 1
-                MsgBox "������� ��������� ���������� ������ ����� ��� 1!", vbOKOnly, PROGRAM_NAME
-            Case 2
-                MsgBox "������������ � ����� ��� �� ������ ���� �������!", vbOKOnly, PROGRAM_NAME
-        End Select
-    End If
-End Sub
-
-Sub Draw_BBL_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_LPU_BBL").Range("CHRT_BBL_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, 19) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, 19)
-            dst.Cells(i, 2) = src.Cells(i, 17)
-            dst.Cells(i, 3) = src.Cells(i, 18)
-            dst.Cells(i, 4) = src.Cells(i, 1)
-        End If
-    Next i
-
-End Sub
-
-Sub Draw_PIE_Chart()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PIE").Range("CHRT_PIE_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_FACT + 1)
-        End If
-    Next i
-End Sub
-
-Sub Draw_PAT_LPU()
-    Dim src As Range
-    Dim dst As Range
-    Dim i As Integer
-    Dim psum As Integer
-    Set src = Worksheets("LPU_LIST").Range("LPU_LIST_INPUT")
-    Set dst = Worksheets("CHRT_PAT_LPU").Range("CHRT_PAT_LPU_DATA")
-    
-    dst.ClearContents
-    
-    For i = 1 To src.Rows.Count
-        psum = 0
-        If src.Cells(i, CLPU_NAME + 1) <> 0 Then
-            dst.Cells(i, 1) = src.Cells(i, CLPU_NAME + 1)
-            dst.Cells(i, 2) = src.Cells(i, CLPU_HIR + 1)
-            psum = psum + src.Cells(i, CLPU_HIR + 1)
-            dst.Cells(i, 3) = src.Cells(i, CLPU_TER + 1)
-            psum = psum + src.Cells(i, CLPU_TER + 1)
-            dst.Cells(i, 4) = src.Cells(i, CLPU_CAR + 1)
-            psum = psum + src.Cells(i, CLPU_CAR + 1)
-            dst.Cells(i, 5) = src.Cells(i, CLPU_PAT_LPU + 1) - psum
-        End If
-    Next i
-End Sub
-
-Sub btLPU_DEL_IT()
-    Dim cLPU As tLPU
-    Dim ent_date As String
-    Dim delete_all As Integer
-    Dim dlg_del As dlg_LPU_delete
-    
-    With Worksheets("LPU_LIST")
-        ent_date = .Range("ent_date")
-        cLPU.id = .getCurrentLPU_ID()
-    End With
-    
-    If cLPU.id = 0 Then
-        MsgBox "������� ��������� ������", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    cLPU = Get_LPU_Record(cLPU.id)
-    
-    Set dlg_del = New dlg_LPU_delete
-    With dlg_del
-        .chbDeleteQTR.Value = True
-        .chbDeleteAll.Value = False
-        .lComment = ent_date & ": �������� ��� '" _
-        & cLPU.name & "', �������������� �� ������:" _
-        & cLPU.address & "."
-        .Show
-        
-        If .Tag = vbOK Then
-            If .chbDeleteAll.Value Then
-                delete_all = _
-                    MsgBox("��� ������ �� ��� � ������ '" & cLPU.name & _
-                    "' ����� ������� ��������.", vbOK, PROGRAM_NAME)
-                If delete_all = vbOK Then
-                    Delete_LPU_Record cLPU
-                End If
-            Else
-                Delete_LPU_RecordQTR cLPU, ent_date
-            End If
-        End If
-    End With
-    
-    With ThisWorkbook
-        .Worksheets(TITLE_SHEET).Select
-        .Worksheets("LPU_LIST").Select
-    End With
-End Sub
-
-Sub btLPU_RET_IT()
-    With Worksheets("LPU_LIST")
-        .Range("ent_date") = ""
-        .Range("LAST_FOCUS") = ""
-        .Range("JUMP") = REP_QTR_SHEET
-    End With
-    ThisWorkbook.Worksheets(REP_QTR_SHEET).Activate
-End Sub
-
-
-Sub btLPU_LIST_DO_IT()
-    Dim i As Integer
-    Dim ent_date As String
-    Dim lpu_id As Long
-    
-    i = Worksheets(VAR_SHEET).Range("QTR_ACTION").Value
-    With Worksheets("LPU_LIST")
-        ent_date = .getEnt_date()
-        
-    
-        lpu_id = .getCurrentLPU_ID
-        If lpu_id <> 0 And i = 1 Then
-            lpu_id = 0
-        End If
-        If lpu_id = 0 Then
-            i = 1
-        End If
-        Select Case i
-            Case 1, 6
-                .SelectLPU_NAME lpu_id, ent_date
-                .Range("JUMP") = ""
-            Case 2
-                If lpu_id <> 0 Then
-                    .SelectLPU_BDGT lpu_id, ent_date
-                    .Range("JUMP") = "LPU_BDGT"
-                End If
-            Case 3
-                If lpu_id <> 0 Then
-                    .SelectLPU_HIR lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_HIR"
-                End If
-            Case 4
-                If lpu_id <> 0 Then
-                    .SelectLPU_TER lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_TER"
-                End If
-            Case 5
-                If lpu_id <> 0 Then
-                    .SelectLPU_C_ACS lpu_id, ent_date
-                    .Range("JUMP") = "LPU_CLSN_C_ACS"
-                End If
-        End Select
-    End With
-    
-    If Range("JUMP") <> "" Then
-        Dim s As String
-        s = Range("JUMP")
-        ThisWorkbook.Worksheets(s).Select
-    End If
-
-End Sub
-
-<<<<<<
-======================
-dbQTR
->>>>>>
-Attribute VB_Name = "dbQTR"
-Option Explicit
-
-Public Type tQTR
-    id As Long
-    entry_date As String
-    rep_id As Long
-    sale_plan As Long
-    ClxnH20mg As Long
-    ClxnH40mg As Long
-    ClxnT40mg As Long
-    ClxnC_IM As Long
-    ClxnC_ACS As Long
-End Type
-
-
-Function GetLastQTR_fromDB() As String
-    Dim dbConnection As Object
-    Dim getCount_QTR_SQL As String
-    Dim getLast_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter"
-    getLast_QTR_SQL = "SELECT MAX(entry_date) as ent_date FROM quarter"
-    
-    dbOpenConnection dbConnection
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    If QTR_Count > 0 Then
-        'we have records
-        dbRecordset.Open getLast_QTR_SQL, dbConnection
-        getLast_QTR_SQL = dbRecordset("ent_date")
-    Else
-        getLast_QTR_SQL = ""
-    End If
-    
-    GetLastQTR_fromDB = getLast_QTR_SQL
-    dbCloseConnection dbConnection
-End Function
-
-Sub Insert_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    If objQTR.id <> 0 Then
-        dbUpdate_QTR_Record dbConnection, objQTR
-    Else
-        dbInsert_QTR_Record dbConnection, objQTR
-    End If
-    dbCloseConnection dbConnection
-End Sub
-
-Function Get_QTR_Record(ent_date As String) As tQTR
-    Dim dbConnection As Object
-    Dim allQTR() As tQTR
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, ent_date)
-    If i <> 0 Then
-        Get_QTR_Record = allQTR(1)
-    End If
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function GetAll_QTR_Records(ByRef All_QTR() As tQTR, ent_date As String) As Integer
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    GetAll_QTR_Records = dbGetAll_QTR_Records(dbConnection, All_QTR, ent_date)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Public Sub Delete_QTR_Record(ByRef objQTR As tQTR)
-    Dim dbConnection As Object
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    dbOpenConnection dbConnection
-    
-    dbDelete_QTR_Record dbConnection, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-
-' if objQTR.ID <> 0 then updatre else insert
-Sub dbInsert_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    
-    dbRecordset.Open "quarter", dbConnection, 2, 2
-    dbRecordset.addnew
-    
-    With objQTR
-        dbRecordset("entry_date") = .entry_date
-        dbRecordset("sale_plan") = .sale_plan
-        dbRecordset("rep_id") = .rep_id
-        dbRecordset("ClxnH20mg") = .ClxnH20mg
-        dbRecordset("ClxnH40mg") = .ClxnH40mg
-        dbRecordset("ClxnT40mg") = .ClxnT40mg
-        dbRecordset("ClxnC_IM") = .ClxnC_IM
-        dbRecordset("ClxnC_ACS") = .ClxnC_ACS
-    End With
-    dbRecordset.Update
-    dbRecordset.MoveLast
-
-    'new ID
-    objQTR.id = dbRecordset("id")
-
-End Sub
-
-Sub dbUpdate_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    Dim Update_SQL As String
-    
-    With objQTR
-        Update_SQL = "UPDATE quarter SET " & _
-            "entry_date='" & .entry_date & "'" & "," & _
-            "rep_id=" & .rep_id & "," & _
-            "sale_plan=" & .sale_plan & "," & _
-            "ClxnH20mg=" & .ClxnH20mg & "," & _
-            "ClxnH40mg=" & .ClxnH40mg & "," & _
-            "ClxnT40mg=" & .ClxnT40mg & "," & _
-            "ClxnC_IM=" & .ClxnC_IM & "," & _
-            "ClxnC_ACS=" & .ClxnC_ACS & _
-            " WHERE id=" & .id
-    End With
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Update_SQL, dbConnection
-End Sub
-
-' if ent_date = % then all_records
-Function dbGetAll_QTR_Records(dbConnection As Object, All_QTR() As tQTR, ent_date As String) As Integer
-    
-    Dim getCount_QTR_SQL As String
-    Dim getAll_QTR_SQL As String
-    Dim QTR_Count As Long
-    QTR_Count = 0
-    
-    getCount_QTR_SQL = "SELECT COUNT(*) AS QTR_TOTAL FROM quarter WHERE entry_date like '" & ent_date & "'"
-    getAll_QTR_SQL = "SELECT * FROM quarter WHERE entry_date like '" & ent_date & "' ORDER BY entry_date"
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open getCount_QTR_SQL, dbConnection
-    
-    If Not dbRecordset.BOF Then
-        QTR_Count = dbRecordset("QTR_TOTAL")
-    End If
-    
-    dbRecordset.Close
-    
-    dbGetAll_QTR_Records = QTR_Count
-    
-    If QTR_Count > 0 Then
-        'we have records
-        ReDim All_QTR(1 To QTR_Count)
-        Dim index As Long
-        index = 1
-        dbRecordset.Open getAll_QTR_SQL, dbConnection
-        
-        If Not dbRecordset.BOF Then
-             Do While Not dbRecordset.EOF
-                 Dim tmp_QTR As tQTR
-                 With tmp_QTR
-                    .entry_date = dbRecordset("entry_date")
-                    .rep_id = dbRecordset("rep_id")
-                    .sale_plan = dbRecordset("sale_plan")
-                    .ClxnH20mg = dbRecordset("ClxnH20mg")
-                    .ClxnH40mg = dbRecordset("ClxnH40mg")
-                    .ClxnT40mg = dbRecordset("ClxnT40mg")
-                    .ClxnC_IM = dbRecordset("ClxnC_IM")
-                    .ClxnC_ACS = dbRecordset("ClxnC_ACS")
-                    .id = dbRecordset("id")
-                 End With
-                 
-                 All_QTR(index) = tmp_QTR
-                 index = index + 1
-                 dbRecordset.MoveNext
-             Loop
-        End If
-    End If
-End Function
-
-Public Sub dbDelete_QTR_Record(dbConnection As Object, ByRef objQTR As tQTR)
-    
-    Dim Delete_SQL As String
-    
-    Delete_SQL = "DELETE FROM quarter " & _
-    "WHERE id=" & objQTR.id
-    
-    
-    Dim dbRecordset As Object
-    Set dbRecordset = CreateObject("ADODB.Recordset")
-    dbRecordset.Open Delete_SQL, dbConnection
-       
-    
-    'delete related budget entries
-    dbDelete_BDGT_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Hir_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_Ter_RecordsByQTR dbConnection, objQTR.entry_date
-    dbDelete_ACS_RecordsByQTR dbConnection, objQTR.entry_date
-       
-End Sub
-<<<<<<
-======================
-cdbQTR
->>>>>>
-Attribute VB_Name = "cdbQTR"
-Option Explicit
-
-Public Type tQTR_COMMON
-    qtr As tQTR
-    i_lcd As Long           ' ����� ��� � ������
-    lcd() As tLPU_COMMON    ' ������ ���
-    c_beds As Long          ' ����� ����
-    c_bdgt_NFG As Long      ' ����� ������ �� ���
-    c_bdgt_NMG As Long      ' ����� ������ �� ���
-    c_bdgt_LPU As Long      ' ����� ������ �� ��������
-    c_sale_PLAN As Long     ' ���� ������ ����
-    c_sale_ALL As Long      ' �������
-    c_sale_HIR As Long      ' � ��������
-    c_sale_TER  As Long     ' � �������
-    c_sale_CRD  As Long     ' � �����������
-    c_pat_HIR   As Long     ' ��������
-    c_pat_TER   As Long     '
-    c_pat_CRD   As Long     '
-    c_pat_ALL   As Long     '
-    c_pat_LPU   As Long     ' ����� ��������
-End Type
-
-Function Get_QTR_CommonList(ByRef qcd() As tQTR_COMMON) As Long
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    Get_QTR_CommonList = dbGet_QTR_CommonList(dbConnection, qcd)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_QTR_CommonList(dbConnection As Object, ByRef qcd() As tQTR_COMMON) As Long
-    Dim i As Long
-    Dim j As Long
-    Dim allQTR() As tQTR
-    i = dbGetAll_QTR_Records(dbConnection, allQTR, "%")
-    dbGet_QTR_CommonList = i
-    If i > 0 Then
-        ReDim qcd(i)
-        For i = 1 To UBound(allQTR)
-            With qcd(i)
-                .qtr = allQTR(i)
-                .c_beds = 0
-                .c_bdgt_NFG = 0
-                .c_bdgt_NMG = 0
-                .c_bdgt_LPU = 0
-                .c_sale_PLAN = 0
-                .c_pat_HIR = 0
-                .c_pat_TER = 0
-                .c_pat_CRD = 0
-                .c_pat_ALL = 0
-                .c_sale_HIR = 0
-                .c_sale_TER = 0
-                .c_sale_CRD = 0
-                .c_sale_ALL = 0
-                .c_pat_LPU = 0
-                
-                j = dbGet_LPU_CommonQTR(dbConnection, .lcd, .qtr)
-                .i_lcd = j
-                If j > 0 Then
-                    For j = 1 To UBound(.lcd)
-                        .c_beds = .c_beds + .lcd(j).lpu.beds
-                        .c_bdgt_NFG = .c_bdgt_NFG + .lcd(j).bdgt.bdgt_NFG
-                        .c_bdgt_NMG = .c_bdgt_NMG + .lcd(j).bdgt.bdgt_NMG
-                        .c_bdgt_LPU = .c_bdgt_LPU + .lcd(j).bdgt_LPU
-                        .c_sale_PLAN = .c_sale_PLAN + .lcd(j).bdgt.sale_plan
-                        .c_pat_HIR = .c_pat_HIR + .lcd(j).pat_HIR
-                        .c_pat_TER = .c_pat_TER + .lcd(j).pat_TER
-                        .c_pat_CRD = .c_pat_CRD + .lcd(j).pat_CRD
-                        .c_pat_ALL = .c_pat_ALL + .lcd(j).pat_ALL
-                        .c_sale_HIR = .c_sale_HIR + .lcd(j).sale_HIR
-                        .c_sale_TER = .c_sale_TER + .lcd(j).sale_TER
-                        .c_sale_CRD = .c_sale_CRD + .lcd(j).sale_CRD
-                        .c_sale_ALL = .c_sale_ALL + .lcd(j).sale_ALL
-                        .c_pat_LPU = .c_pat_LPU + .lcd(j).pat_LPU
-                    Next j
-                    
-                End If
-            End With
-        Next i
-    End If
-End Function
-
-Function GetLastQtr() As String
-    Dim s As String
-    Dim r As Range
-    Set r = Worksheets(REP_QTR_SHEET).Range("REP_QTR_INPUT_DATA")
-    Do While r.Cells(1, 1) <> ""
-        s = r.Cells(1, 1)
-        Set r = r.Cells.Offset(1, 0)
-    Loop
-    GetLastQtr = s
-End Function
-
-Function GetNextQTR(ent_date As String) As String
-    Dim rd As Range
-    Dim idx As Integer
-    Dim b As Variant
-    Dim dlg As dlg_newQTR
-    Set dlg = New dlg_newQTR
-    
-    On Error GoTo l_exit
-    If ent_date = "" Then
-        Dim ir As Variant
-        idx = 0
-        dlg.Show
-        b = dlg.Tag
-            
-        If IsNumeric(b) Then
-            GetNextQTR = dlg.cbQTR
-        Else
-            GetNextQTR = ""
-        End If
-    Else
-        Set rd = Worksheets(VAR_SHEET).Range("Date_Lst")
-        idx = WorksheetFunction.Match(ent_date, rd, 0)
-        GetNextQTR = WorksheetFunction.index(rd, idx + 1, 1)
-    End If
-l_exit:
-End Function
-<<<<<<
-======================
-mRestView
->>>>>>
-Attribute VB_Name = "mRestView"
-Option Explicit
-
-Sub xlRestoreView()
-Attribute xlRestoreView.VB_Description = "Macro recorded 25.09.2003 by nick"
-Attribute xlRestoreView.VB_ProcData.VB_Invoke_Func = " \n14"
-    With Application
-        .CommandBars("Standard").Visible = True
-        .CommandBars("Formatting").Visible = True
-        .DisplayFormulaBar = True
-        .DisplayStatusBar = True
-        .DisplayCommentIndicator = xlCommentIndicatorOnly
-        .CellDragAndDrop = True
-        .EditDirectlyInCell = True
-    End With
-End Sub
-<<<<<<
-======================
-dlg_newQTR
->>>>>>
-Attribute VB_Name = "dlg_newQTR"
-Attribute VB_Base = "0{2FC04B4C-EB99-433E-ACDB-A920D02B9B5B}{777B85CC-ADE3-4188-94C8-9E07DA8B5076}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-<<<<<<
-======================
-mDec2TS
->>>>>>
-Attribute VB_Name = "mDec2TS"
-Option Explicit
-
-
-Function Dec2ThirtySix(Dec As Long) As String
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim idx As Integer
-    
-    ThirtySixStr = ""
-    
-    If Dec = 0 Then
-        ThirtySixStr = Mid(ThirtySixNumbers, 1, 1)
-    Else
-        While Dec <> 0
-            idx = Dec Mod ThirtySixBase
-            ThirtySixStr = Mid(ThirtySixNumbers, idx + 1, 1) + ThirtySixStr
-            Dec = Dec \ ThirtySixBase
-        Wend
-    End If
-    Dec2ThirtySix = ThirtySixStr
-End Function
-
-Function ThirtySix2Dec(TS As String) As Long
-
-Const ThirtySixNumbers As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-Const ThirtySixBase As Integer = 36
-    
-    Dim ThirtySixStr As String
-    Dim lastdigit As String
-    Dim idx As Long
-    Dim idx_2 As Integer
-    Dim Dec As Long
-    
-    Dec = 0
-    idx_2 = 0
-    
-    If TS = "" Then
-        Dec = 0
-    Else
-        While TS <> ""
-            lastdigit = Right(TS, 1)
-            idx = InStr(1, ThirtySixNumbers, lastdigit)
-            Dec = Dec + (idx - 1) * ThirtySixBase ^ idx_2
-            idx_2 = idx_2 + 1
-            TS = Mid(TS, 1, Len(TS) - 1)
-        Wend
-    End If
-    ThirtySix2Dec = Dec
-End Function
-<<<<<<
-======================
-CHRT_LPU_BBL
->>>>>>
-Attribute VB_Name = "CHRT_LPU_BBL"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Unprotect
-    Range("view_key") = True
-    On Error Resume Next
-    ChangeLabels
-    Range("A1").Select
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Unprotect
-    Dim s As String
-    s = Range("ret_addr")
-    Protect UserInterfaceOnly:=True
-    Wks_select (s)
-End Sub
-
-Sub BCLabelChng_Click()
-    Unprotect
-    If Range("view_key") Then
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ��������"
-    Else
-        Shapes("BCLabelChng").DrawingObject.Caption = "�������� ������"
-    End If
-    Range("view_key") = Not Range("view_key")
-    ChangeLabels
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Sub ChangeLabels()
-    Dim i As Integer
-    Dim offset_text As Integer
-    Dim src As Range
-    Set src = Range("CHRT_BBL_DATA")
-    
-    offset_text = 3
-    If Range("view_key") Then
-        offset_text = 4
-    End If
-    
-    On Error GoTo ExitLabel
-    
-    With ChartObjects(1).Chart
-        With .SeriesCollection(1)
-            For i = 1 To .Points.Count
-                On Error Resume Next
-                .Points(i).DataLabel.Characters.Text = Format(src.Cells(i, offset_text))
-            Next i
-        End With
-    End With
-ExitLabel:
-End Sub
-
-<<<<<<
-======================
-CHRT_PAT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PAT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-<<<<<<
-======================
-CHRT_PAT_LPU
->>>>>>
-Attribute VB_Name = "CHRT_PAT_LPU"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_nextQTR
->>>>>>
-Attribute VB_Name = "dlg_nextQTR"
-Attribute VB_Base = "0{3F7D7D75-90F6-4829-9E24-CA5391BB2A03}{A1A0F296-0D28-4123-8E38-82FA6EE6F2EF}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Option Explicit
-
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-
-
-<<<<<<
-======================
-cdbLPU
->>>>>>
-Attribute VB_Name = "cdbLPU"
-Option Explicit
-
-Public Type tLPU_COMMON
-    lpu As tLPU
-    bdgt As tBUDGET
-    i_hir As Long
-    hir() As tHIRURGIA
-    i_ter As Long
-    ter() As tTERAPIA
-    i_ACS As Long
-    ACS() As tACS
-    bdgt_LPU As Long
-    sale_HIR As Long
-    sale_TER As Long
-    sale_CRD As Long
-    sale_ALL As Long
-    pat_HIR As Long
-    pat_TER As Long
-    pat_CRD As Long
-    pat_ALL As Long     ' ����� ���� ��������� �� ��������
-    pat_LPU As Long     ' ����� ������������� ��������� ��� ������ ��������
-End Type
-
-Function Get_LPU_CommonQTR(ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim dbConnection As Object
-    
-    dbOpenConnection dbConnection
-    
-    Get_LPU_CommonQTR = dbGet_LPU_CommonQTR(dbConnection, lcd, objQTR)
-    
-    dbCloseConnection dbConnection
-End Function
-
-Function dbGet_LPU_CommonQTR(dbConnection As Object, ByRef lcd() As tLPU_COMMON, ByRef objQTR As tQTR) As Long
-    Dim allLPU() As tLPU
-    Dim i As Long
-    
-    i = dbGetAllLPUbyQTR(dbConnection, allLPU, objQTR.entry_date)
-    dbGet_LPU_CommonQTR = i
-    If i > 0 Then
-        ReDim lcd(i)
-        For i = 1 To UBound(allLPU)
-            dbGet_LPU_Common dbConnection, lcd(i), allLPU(i), objQTR
-        Next i
-    End If
-End Function
-
-Sub Get_LPU_Common(ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-    Dim dbConnection As Object
-    dbOpenConnection dbConnection
-    
-    dbGet_LPU_Common dbConnection, lcd, cLPU, objQTR
-    
-    dbCloseConnection dbConnection
-End Sub
-
-Sub dbGet_LPU_Common(dbConnection As Object, ByRef lcd As tLPU_COMMON, cLPU As tLPU, objQTR As tQTR)
-
-    lcd.lpu = cLPU
-    lcd.bdgt = dbGet_BDGT_Record(dbConnection, cLPU.id, objQTR.entry_date)
-    lcd.i_hir = dbGetAll_Hir_RecordsbyLPU_ID(dbConnection, lcd.hir, cLPU.id, objQTR.entry_date)
-    lcd.i_ter = dbGetAll_Ter_RecordsbyLPU_ID(dbConnection, lcd.ter, cLPU.id, objQTR.entry_date)
-    lcd.i_ACS = dbGetAll_ACS_RecordsbyLPU_ID(dbConnection, lcd.ACS, cLPU.id, objQTR.entry_date)
-    With lcd
-        .bdgt_LPU = .bdgt.bdgt_NFG + .bdgt.bdgt_NMG
-        .pat_LPU = 0
-        If .i_hir > 0 Then
-            .pat_HIR = .hir(1).patients_ambulator_clexan + .hir(1).patients_stationar_clexan
-            .sale_HIR = objQTR.ClxnH20mg * (.hir(1).patients_ambulator_clexan_20mg + .hir(1).patients_stationar_clexan_20mg)
-            .sale_HIR = .sale_HIR + objQTR.ClxnH40mg * (.hir(1).patients_ambulator_clexan_40mg + .hir(1).patients_stationar_clexan_40mg)
-            .pat_LPU = .pat_LPU + .hir(1).operations_per_quarter
-        End If
-        If .i_ter > 0 Then
-            .pat_TER = .ter(1).patients_ambulator_clexan + .ter(1).patients_stationar_clexan
-            .sale_TER = .pat_TER * objQTR.ClxnT40mg
-            .pat_LPU = .pat_LPU + .ter(1).patients_per_quarter
-        End If
-        If .i_ACS > 0 Then
-            .pat_CRD = .ACS(1).patients_stationar_clexan
-            .sale_CRD = .pat_CRD * objQTR.ClxnC_ACS
-            .pat_LPU = .pat_LPU + .ACS(1).patients_per_quarter
-        End If
-        .pat_ALL = .pat_HIR + .pat_TER + .pat_CRD
-        .sale_ALL = .sale_HIR + .sale_TER + .sale_CRD
-    End With
-End Sub
-
-<<<<<<
-======================
-CHRT_PIE
->>>>>>
-Attribute VB_Name = "CHRT_PIE"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-   
-    Unprotect
-    On Error Resume Next
-    Range("P5:Q24").Sort _
-        Key1:=Range("Q5"), _
-        Order1:=xlDescending, _
-        Header:=xlGuess, _
-        OrderCustom:=1, _
-        MatchCase:=False, _
-        Orientation:=xlTopToBottom
-        
-    Protect UserInterfaceOnly:=True
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Range("A1").Select
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_PLN_QTR
->>>>>>
-Attribute VB_Name = "CHRT_PLN_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-CHRT_BDGT_QTR
->>>>>>
-Attribute VB_Name = "CHRT_BDGT_QTR"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-Option Explicit
-
-Private Sub Worksheet_Activate()
-    Range("A1").Select
-End Sub
-
-Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-    Worksheet_Activate
-End Sub
-
-Sub Done()
-    Dim s As String
-    s = Range("ret_addr")
-    Wks_select (s)
-End Sub
-
-<<<<<<
-======================
-dlg_LPU_delete
->>>>>>
-Attribute VB_Name = "dlg_LPU_delete"
-Attribute VB_Base = "0{91AE5FA0-01C7-4C10-9E5F-D1D2DDF29401}{5726592A-BC0A-4E79-A963-35D354045716}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dlg_Mail
->>>>>>
-Attribute VB_Name = "dlg_Mail"
-Attribute VB_Base = "0{FB055133-927F-41FF-BC90-442833A40591}{11BCAB43-1EDD-440B-AB0E-20CD6E42E11A}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = False
-Private Sub btCancel_Click()
-    Me.Hide
-    Me.Tag = vbCancel
-End Sub
-
-Private Sub btOk_Click()
-    Me.Hide
-    Me.Tag = vbOK
-End Sub
-<<<<<<
-======================
-dbREP_id
->>>>>>
-Attribute VB_Name = "dbREP_id"
-Public Type tID_REP
-    id As Long
-    FirstName As String
-    LastName As String
-    Region As Integer
-    City As Integer
-End Type
-
-Public Type tID_REP_COMMON
-    id_rep As tID_REP
-    i_qtr As Long
-    qtrs As tQTR_COMMON
-End Type
-<<<<<<
-======================
-cdbExport
->>>>>>
-Attribute VB_Name = "cdbExport"
-Option Explicit
-
-Function GetDBSN() As String
-    Dim n As Long
-    Randomize Timer
-    n = Int((100000000 - 1000000 + 1) * Rnd + 1000000)
-    GetDBSN = Dec2ThirtySix(n)
-End Function
-
-Sub dbExport()
-    Dim src_file As String
-    Dim dst_file As String
-    Dim last_qtr As String
-    
-    On Error GoTo ErrHandler
-    
-    last_qtr = GetLastQTR_fromDB
-    If last_qtr = "" Then
-        MsgBox "��� ������� � ���� ������. ������� ����������.", vbOKOnly, PROGRAM_NAME
-        Exit Sub
-    End If
-    
-    src_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_FILENAME & PROGRAM_DATAEXT
-    dst_file = GetWBPath(ThisWorkbook.FullName) & PROGRAM_EXPORTNAME & last_qtr & "_" & GetDBSN() & PROGRAM_DATAEXT
-        
-    Dim fs
-    
-    Set fs = CreateObject("Scripting.FileSystemObject")
-    
-    fs.CopyFile src_file, dst_file
-    
-    If fs.FileExists(dst_file) Then
-        MsgBox "������ �������������� � ����:" & vbCrLf _
-                & dst_file & vbCrLf _
-                & "����������� ��� ��� ��������", vbOKOnly, PROGRAM_NAME
-    Else
-        MsgBox "��� �������� �������� ������.", vbOKOnly, PROGRAM_NAME
-    End If
-
-Exit Sub
-
-ErrHandler:
-    If err.number <> 53 Then
-        MsgBox "�������������� ������: " & err.Description
-    End If
-    Resume Next
-
-End Sub
-
-<<<<<<
-======================
-mRegs
->>>>>>
-Attribute VB_Name = "mRegs"
-Option Explicit
-
-Function GetRegionName(idx As Integer) As String
-    GetRegionName = Worksheets(REGS_SHEET).Range("LST_REGIONS").Cells(idx + 1, 1).Text
-End Function
-
-Function GetCityName(idx_reg As Integer, idx_city As Integer) As String
-    GetCityName = Worksheets(REGS_SHEET).Range("CITY_TABLES").Offset(idx_city + 1, idx_reg * 2).Text
-End Function
-
-Sub t()
-    Dim r As Integer
-    Dim c As Integer
-    Dim s As String
-    
-    r = 3
-    c = 3
-    s = GetRegionName(r)
-    s = s & ", " & GetCityName(r, c)
-    MsgBox s
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub Forecast()
-Attribute Forecast.VB_Description = "Macro recorded 06.12.2002 by nick"
-Attribute Forecast.VB_ProcData.VB_Invoke_Func = "f\n14"
-    With Selection
-        .Cells(1, 2).GoalSeek Goal:=1746, ChangingCell:=.Cells(1, 1)
-    End With
-End Sub
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet3
->>>>>>
-Attribute VB_Name = "Sheet3"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-Sub RandFill()
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet6
->>>>>>
-Attribute VB_Name = "Sheet6"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet19
->>>>>>
-Attribute VB_Name = "Sheet19"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet18
->>>>>>
-Attribute VB_Name = "Sheet18"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet9
->>>>>>
-Attribute VB_Name = "Sheet9"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet12
->>>>>>
-Attribute VB_Name = "Sheet12"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet7
->>>>>>
-Attribute VB_Name = "Sheet7"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet13
->>>>>>
-Attribute VB_Name = "Sheet13"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet14
->>>>>>
-Attribute VB_Name = "Sheet14"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet15
->>>>>>
-Attribute VB_Name = "Sheet15"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet8
->>>>>>
-Attribute VB_Name = "Sheet8"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-    Selection.Formula = "=rand()"
-End Sub
-<<<<<<
-======================
-Sheet16
->>>>>>
-Attribute VB_Name = "Sheet16"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet17
->>>>>>
-Attribute VB_Name = "Sheet17"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-======================
-Sheet21
->>>>>>
-Attribute VB_Name = "Sheet21"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-Sheet20
->>>>>>
-Attribute VB_Name = "Sheet20"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet10
->>>>>>
-Attribute VB_Name = "Sheet10"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet5
->>>>>>
-Attribute VB_Name = "Sheet5"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet11
->>>>>>
-Attribute VB_Name = "Sheet11"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Module1
->>>>>>
-Attribute VB_Name = "Module1"
-
-Sub RandFill()
-Attribute RandFill.VB_ProcData.VB_Invoke_Func = "r\n14"
-    Selection.Formula = "=rand()"
-End Sub
-
-<<<<<<
-Project Name : 'VBAProject'
-Quirk - duff tag length======================
-ThisWorkbook
->>>>>>
-Attribute VB_Name = "ThisWorkbook"
-Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet1
->>>>>>
-Attribute VB_Name = "Sheet1"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet2
->>>>>>
-Attribute VB_Name = "Sheet2"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-Sheet4
->>>>>>
-Attribute VB_Name = "Sheet4"
-Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = True
-Attribute VB_TemplateDerived = False
-Attribute VB_Customizable = True
-<<<<<<
-======================
-ListFunc
->>>>>>
-Attribute VB_Name = "ListFunc"
-Option Explicit
-
-Function getEqClass(r As Range, ClRange As Range) As Integer
-    Dim i As Integer
-    For i = 1 To ClRange.Count
-        If r < ClRange.Cells(i) Then
-            getEqClass = i
-            Exit Function
-        End If
-    Next i
-End Function
-
-Function getClassLetter(Idx As Integer, ClNames As Range) As String
-    getClassLetter = ClNames.Cells(Idx)
-End Function
-
-Function GetEqLetter(r As Range, ClRange As Range, ClNames As Range) As String
-    GetEqLetter = getClassLetter(getEqClass(r, ClRange), ClNames)
-End Function
-<<<<<<
diff --git a/test/macro/vbarangetest.ods b/test/macro/vbarangetest.ods
deleted file mode 100644
index 2033a9425..000000000
--- a/test/macro/vbarangetest.ods
+++ /dev/null
diff --git a/test/macro/vbasheettest.ods b/test/macro/vbasheettest.ods
deleted file mode 100644
index 374d98189..000000000
--- a/test/macro/vbasheettest.ods
+++ /dev/null
diff --git a/test/macro/vbatest.ods b/test/macro/vbatest.ods
deleted file mode 100644
index 10542eedf..000000000
--- a/test/macro/vbatest.ods
+++ /dev/null
diff --git a/test/macro/vbatest.xls b/test/macro/vbatest.xls
deleted file mode 100644
index 33f2cfc5e..000000000
--- a/test/macro/vbatest.xls
+++ /dev/null
diff --git a/test/macro/vbatimer.xls b/test/macro/vbatimer.xls
deleted file mode 100644
index 75586916f..000000000
--- a/test/macro/vbatimer.xls
+++ /dev/null
diff --git a/test/macro/worm.xls b/test/macro/worm.xls
deleted file mode 100644
index eaea4c29a..000000000
--- a/test/macro/worm.xls
+++ /dev/null
diff --git a/test/mono/COPYING b/test/mono/COPYING
deleted file mode 100644
index b1e3f5a26..000000000
--- a/test/mono/COPYING
+++ /dev/null
@@ -1,504 +0,0 @@
-		  GNU LESSER GENERAL PUBLIC LICENSE
-		       Version 2.1, February 1999
-
- Copyright (C) 1991, 1999 Free Software Foundation, Inc.
-     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-[This is the first released version of the Lesser GPL.  It also counts
- as the successor of the GNU Library Public License, version 2, hence
- the version number 2.1.]
-
-			    Preamble
-
-  The licenses for most software are designed to take away your
-freedom to share and change it.  By contrast, the GNU General Public
-Licenses are intended to guarantee your freedom to share and change
-free software--to make sure the software is free for all its users.
-
-  This license, the Lesser General Public License, applies to some
-specially designated software packages--typically libraries--of the
-Free Software Foundation and other authors who decide to use it.  You
-can use it too, but we suggest you first think carefully about whether
-this license or the ordinary General Public License is the better
-strategy to use in any particular case, based on the explanations below.
-
-  When we speak of free software, we are referring to freedom of use,
-not price.  Our General Public Licenses are designed to make sure that
-you have the freedom to distribute copies of free software (and charge
-for this service if you wish); that you receive source code or can get
-it if you want it; that you can change the software and use pieces of
-it in new free programs; and that you are informed that you can do
-these things.
-
-  To protect your rights, we need to make restrictions that forbid
-distributors to deny you these rights or to ask you to surrender these
-rights.  These restrictions translate to certain responsibilities for
-you if you distribute copies of the library or if you modify it.
-
-  For example, if you distribute copies of the library, whether gratis
-or for a fee, you must give the recipients all the rights that we gave
-you.  You must make sure that they, too, receive or can get the source
-code.  If you link other code with the library, you must provide
-complete object files to the recipients, so that they can relink them
-with the library after making changes to the library and recompiling
-it.  And you must show them these terms so they know their rights.
-
-  We protect your rights with a two-step method: (1) we copyright the
-library, and (2) we offer you this license, which gives you legal
-permission to copy, distribute and/or modify the library.
-
-  To protect each distributor, we want to make it very clear that
-there is no warranty for the free library.  Also, if the library is
-modified by someone else and passed on, the recipients should know
-that what they have is not the original version, so that the original
-author's reputation will not be affected by problems that might be
-introduced by others.
-
-  Finally, software patents pose a constant threat to the existence of
-any free program.  We wish to make sure that a company cannot
-effectively restrict the users of a free program by obtaining a
-restrictive license from a patent holder.  Therefore, we insist that
-any patent license obtained for a version of the library must be
-consistent with the full freedom of use specified in this license.
-
-  Most GNU software, including some libraries, is covered by the
-ordinary GNU General Public License.  This license, the GNU Lesser
-General Public License, applies to certain designated libraries, and
-is quite different from the ordinary General Public License.  We use
-this license for certain libraries in order to permit linking those
-libraries into non-free programs.
-
-  When a program is linked with a library, whether statically or using
-a shared library, the combination of the two is legally speaking a
-combined work, a derivative of the original library.  The ordinary
-General Public License therefore permits such linking only if the
-entire combination fits its criteria of freedom.  The Lesser General
-Public License permits more lax criteria for linking other code with
-the library.
-
-  We call this license the "Lesser" General Public License because it
-does Less to protect the user's freedom than the ordinary General
-Public License.  It also provides other free software developers Less
-of an advantage over competing non-free programs.  These disadvantages
-are the reason we use the ordinary General Public License for many
-libraries.  However, the Lesser license provides advantages in certain
-special circumstances.
-
-  For example, on rare occasions, there may be a special need to
-encourage the widest possible use of a certain library, so that it becomes
-a de-facto standard.  To achieve this, non-free programs must be
-allowed to use the library.  A more frequent case is that a free
-library does the same job as widely used non-free libraries.  In this
-case, there is little to gain by limiting the free library to free
-software only, so we use the Lesser General Public License.
-
-  In other cases, permission to use a particular library in non-free
-programs enables a greater number of people to use a large body of
-free software.  For example, permission to use the GNU C Library in
-non-free programs enables many more people to use the whole GNU
-operating system, as well as its variant, the GNU/Linux operating
-system.
-
-  Although the Lesser General Public License is Less protective of the
-users' freedom, it does ensure that the user of a program that is
-linked with the Library has the freedom and the wherewithal to run
-that program using a modified version of the Library.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.  Pay close attention to the difference between a
-"work based on the library" and a "work that uses the library".  The
-former contains code derived from the library, whereas the latter must
-be combined with the library in order to run.
-
-		  GNU LESSER GENERAL PUBLIC LICENSE
-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-  0. This License Agreement applies to any software library or other
-program which contains a notice placed by the copyright holder or
-other authorized party saying it may be distributed under the terms of
-this Lesser General Public License (also called "this License").
-Each licensee is addressed as "you".
-
-  A "library" means a collection of software functions and/or data
-prepared so as to be conveniently linked with application programs
-(which use some of those functions and data) to form executables.
-
-  The "Library", below, refers to any such software library or work
-which has been distributed under these terms.  A "work based on the
-Library" means either the Library or any derivative work under
-copyright law: that is to say, a work containing the Library or a
-portion of it, either verbatim or with modifications and/or translated
-straightforwardly into another language.  (Hereinafter, translation is
-included without limitation in the term "modification".)
-
-  "Source code" for a work means the preferred form of the work for
-making modifications to it.  For a library, complete source code means
-all the source code for all modules it contains, plus any associated
-interface definition files, plus the scripts used to control compilation
-and installation of the library.
-
-  Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope.  The act of
-running a program using the Library is not restricted, and output from
-such a program is covered only if its contents constitute a work based
-on the Library (independent of the use of the Library in a tool for
-writing it).  Whether that is true depends on what the Library does
-and what the program that uses the Library does.
-  
-  1. You may copy and distribute verbatim copies of the Library's
-complete source code as you receive it, in any medium, provided that
-you conspicuously and appropriately publish on each copy an
-appropriate copyright notice and disclaimer of warranty; keep intact
-all the notices that refer to this License and to the absence of any
-warranty; and distribute a copy of this License along with the
-Library.
-
-  You may charge a fee for the physical act of transferring a copy,
-and you may at your option offer warranty protection in exchange for a
-fee.
-
-  2. You may modify your copy or copies of the Library or any portion
-of it, thus forming a work based on the Library, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
-    a) The modified work must itself be a software library.
-
-    b) You must cause the files modified to carry prominent notices
-    stating that you changed the files and the date of any change.
-
-    c) You must cause the whole of the work to be licensed at no
-    charge to all third parties under the terms of this License.
-
-    d) If a facility in the modified Library refers to a function or a
-    table of data to be supplied by an application program that uses
-    the facility, other than as an argument passed when the facility
-    is invoked, then you must make a good faith effort to ensure that,
-    in the event an application does not supply such function or
-    table, the facility still operates, and performs whatever part of
-    its purpose remains meaningful.
-
-    (For example, a function in a library to compute square roots has
-    a purpose that is entirely well-defined independent of the
-    application.  Therefore, Subsection 2d requires that any
-    application-supplied function or table used by this function must
-    be optional: if the application does not supply it, the square
-    root function must still compute square roots.)
-
-These requirements apply to the modified work as a whole.  If
-identifiable sections of that work are not derived from the Library,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works.  But when you
-distribute the same sections as part of a whole which is a work based
-on the Library, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote
-it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Library.
-
-In addition, mere aggregation of another work not based on the Library
-with the Library (or with a work based on the Library) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
-  3. You may opt to apply the terms of the ordinary GNU General Public
-License instead of this License to a given copy of the Library.  To do
-this, you must alter all the notices that refer to this License, so
-that they refer to the ordinary GNU General Public License, version 2,
-instead of to this License.  (If a newer version than version 2 of the
-ordinary GNU General Public License has appeared, then you can specify
-that version instead if you wish.)  Do not make any other change in
-these notices.
-
-  Once this change is made in a given copy, it is irreversible for
-that copy, so the ordinary GNU General Public License applies to all
-subsequent copies and derivative works made from that copy.
-
-  This option is useful when you wish to copy part of the code of
-the Library into a program that is not a library.
-
-  4. You may copy and distribute the Library (or a portion or
-derivative of it, under Section 2) in object code or executable form
-under the terms of Sections 1 and 2 above provided that you accompany
-it with the complete corresponding machine-readable source code, which
-must be distributed under the terms of Sections 1 and 2 above on a
-medium customarily used for software interchange.
-
-  If distribution of object code is made by offering access to copy
-from a designated place, then offering equivalent access to copy the
-source code from the same place satisfies the requirement to
-distribute the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
-  5. A program that contains no derivative of any portion of the
-Library, but is designed to work with the Library by being compiled or
-linked with it, is called a "work that uses the Library".  Such a
-work, in isolation, is not a derivative work of the Library, and
-therefore falls outside the scope of this License.
-
-  However, linking a "work that uses the Library" with the Library
-creates an executable that is a derivative of the Library (because it
-contains portions of the Library), rather than a "work that uses the
-library".  The executable is therefore covered by this License.
-Section 6 states terms for distribution of such executables.
-
-  When a "work that uses the Library" uses material from a header file
-that is part of the Library, the object code for the work may be a
-derivative work of the Library even though the source code is not.
-Whether this is true is especially significant if the work can be
-linked without the Library, or if the work is itself a library.  The
-threshold for this to be true is not precisely defined by law.
-
-  If such an object file uses only numerical parameters, data
-structure layouts and accessors, and small macros and small inline
-functions (ten lines or less in length), then the use of the object
-file is unrestricted, regardless of whether it is legally a derivative
-work.  (Executables containing this object code plus portions of the
-Library will still fall under Section 6.)
-
-  Otherwise, if the work is a derivative of the Library, you may
-distribute the object code for the work under the terms of Section 6.
-Any executables containing that work also fall under Section 6,
-whether or not they are linked directly with the Library itself.
-
-  6. As an exception to the Sections above, you may also combine or
-link a "work that uses the Library" with the Library to produce a
-work containing portions of the Library, and distribute that work
-under terms of your choice, provided that the terms permit
-modification of the work for the customer's own use and reverse
-engineering for debugging such modifications.
-
-  You must give prominent notice with each copy of the work that the
-Library is used in it and that the Library and its use are covered by
-this License.  You must supply a copy of this License.  If the work
-during execution displays copyright notices, you must include the
-copyright notice for the Library among them, as well as a reference
-directing the user to the copy of this License.  Also, you must do one
-of these things:
-
-    a) Accompany the work with the complete corresponding
-    machine-readable source code for the Library including whatever
-    changes were used in the work (which must be distributed under
-    Sections 1 and 2 above); and, if the work is an executable linked
-    with the Library, with the complete machine-readable "work that
-    uses the Library", as object code and/or source code, so that the
-    user can modify the Library and then relink to produce a modified
-    executable containing the modified Library.  (It is understood
-    that the user who changes the contents of definitions files in the
-    Library will not necessarily be able to recompile the application
-    to use the modified definitions.)
-
-    b) Use a suitable shared library mechanism for linking with the
-    Library.  A suitable mechanism is one that (1) uses at run time a
-    copy of the library already present on the user's computer system,
-    rather than copying library functions into the executable, and (2)
-    will operate properly with a modified version of the library, if
-    the user installs one, as long as the modified version is
-    interface-compatible with the version that the work was made with.
-
-    c) Accompany the work with a written offer, valid for at
-    least three years, to give the same user the materials
-    specified in Subsection 6a, above, for a charge no more
-    than the cost of performing this distribution.
-
-    d) If distribution of the work is made by offering access to copy
-    from a designated place, offer equivalent access to copy the above
-    specified materials from the same place.
-
-    e) Verify that the user has already received a copy of these
-    materials or that you have already sent this user a copy.
-
-  For an executable, the required form of the "work that uses the
-Library" must include any data and utility programs needed for
-reproducing the executable from it.  However, as a special exception,
-the materials to be distributed need not include anything that is
-normally distributed (in either source or binary form) with the major
-components (compiler, kernel, and so on) of the operating system on
-which the executable runs, unless that component itself accompanies
-the executable.
-
-  It may happen that this requirement contradicts the license
-restrictions of other proprietary libraries that do not normally
-accompany the operating system.  Such a contradiction means you cannot
-use both them and the Library together in an executable that you
-distribute.
-
-  7. You may place library facilities that are a work based on the
-Library side-by-side in a single library together with other library
-facilities not covered by this License, and distribute such a combined
-library, provided that the separate distribution of the work based on
-the Library and of the other library facilities is otherwise
-permitted, and provided that you do these two things:
-
-    a) Accompany the combined library with a copy of the same work
-    based on the Library, uncombined with any other library
-    facilities.  This must be distributed under the terms of the
-    Sections above.
-
-    b) Give prominent notice with the combined library of the fact
-    that part of it is a work based on the Library, and explaining
-    where to find the accompanying uncombined form of the same work.
-
-  8. You may not copy, modify, sublicense, link with, or distribute
-the Library except as expressly provided under this License.  Any
-attempt otherwise to copy, modify, sublicense, link with, or
-distribute the Library is void, and will automatically terminate your
-rights under this License.  However, parties who have received copies,
-or rights, from you under this License will not have their licenses
-terminated so long as such parties remain in full compliance.
-
-  9. You are not required to accept this License, since you have not
-signed it.  However, nothing else grants you permission to modify or
-distribute the Library or its derivative works.  These actions are
-prohibited by law if you do not accept this License.  Therefore, by
-modifying or distributing the Library (or any work based on the
-Library), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Library or works based on it.
-
-  10. Each time you redistribute the Library (or any work based on the
-Library), the recipient automatically receives a license from the
-original licensor to copy, distribute, link with or modify the Library
-subject to these terms and conditions.  You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties with
-this License.
-
-  11. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License.  If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Library at all.  For example, if a patent
-license would not permit royalty-free redistribution of the Library by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Library.
-
-If any portion of this section is held invalid or unenforceable under any
-particular circumstance, the balance of the section is intended to apply,
-and the section as a whole is intended to apply in other circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system which is
-implemented by public license practices.  Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
-  12. If the distribution and/or use of the Library is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Library under this License may add
-an explicit geographical distribution limitation excluding those countries,
-so that distribution is permitted only in or among countries not thus
-excluded.  In such case, this License incorporates the limitation as if
-written in the body of this License.
-
-  13. The Free Software Foundation may publish revised and/or new
-versions of the Lesser General Public License from time to time.
-Such new versions will be similar in spirit to the present version,
-but may differ in detail to address new problems or concerns.
-
-Each version is given a distinguishing version number.  If the Library
-specifies a version number of this License which applies to it and
-"any later version", you have the option of following the terms and
-conditions either of that version or of any later version published by
-the Free Software Foundation.  If the Library does not specify a
-license version number, you may choose any version ever published by
-the Free Software Foundation.
-
-  14. If you wish to incorporate parts of the Library into other free
-programs whose distribution conditions are incompatible with these,
-write to the author to ask for permission.  For software which is
-copyrighted by the Free Software Foundation, write to the Free
-Software Foundation; we sometimes make exceptions for this.  Our
-decision will be guided by the two goals of preserving the free status
-of all derivatives of our free software and of promoting the sharing
-and reuse of software generally.
-
-			    NO WARRANTY
-
-  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
-WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
-EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
-OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
-KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
-LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
-  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
-AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
-LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
-FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGES.
-
-		     END OF TERMS AND CONDITIONS
-
-           How to Apply These Terms to Your New Libraries
-
-  If you develop a new library, and you want it to be of the greatest
-possible use to the public, we recommend making it free software that
-everyone can redistribute and change.  You can do so by permitting
-redistribution under these terms (or, alternatively, under the terms of the
-ordinary General Public License).
-
-  To apply these terms, attach the following notices to the library.  It is
-safest to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least the
-"copyright" line and a pointer to where the full notice is found.
-
-    <one line to give the library's name and a brief idea of what it does.>
-    Copyright (C) <year>  <name of author>
-
-    This library is free software; you can redistribute it and/or
-    modify it under the terms of the GNU Lesser General Public
-    License as published by the Free Software Foundation; either
-    version 2.1 of the License, or (at your option) any later version.
-
-    This library is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-    Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public
-    License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-
-Also add information on how to contact you by electronic and paper mail.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the library, if
-necessary.  Here is a sample; alter the names:
-
-  Yoyodyne, Inc., hereby disclaims all copyright interest in the
-  library `Frob' (a library for tweaking knobs) written by James Random Hacker.
-
-  <signature of Ty Coon>, 1 April 1990
-  Ty Coon, President of Vice
-
-That's all there is to it!
-
-
diff --git a/test/mono/GeneralTableSample.cs b/test/mono/GeneralTableSample.cs
deleted file mode 100644
index ced0edf93..000000000
--- a/test/mono/GeneralTableSample.cs
+++ /dev/null
@@ -1,206 +0,0 @@
-
-using System;
-
-
-// __________  implementation  ____________________________________
-
-/** Create a spreadsheet document and provide access to table contents.
- */
-public class GeneralTableSample : SpreadsheetDocHelper
-{
-
-    public static void Main( String [] args )
-    {
-        try
-        {
-            using ( GeneralTableSample aSample =
-                      new GeneralTableSample( args ) )
-            {
-                aSample.doSampleFunction();
-            }
-            Console.WriteLine( "Sample done." );
-        }
-        catch (Exception ex)
-        {
-            Console.WriteLine( "Sample caught exception! " + ex );
-        }
-    }
-
-// ________________________________________________________________
-    
-    public GeneralTableSample( String[] args ) : base( args )
-    {
-    }
-
-// ________________________________________________________________
-
-    /// This sample function modifies cells and cell ranges.
-    public void doSampleFunction()
-    {
-        // for common usage
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet = getSpreadsheet( 0 );
-        unoidl.com.sun.star.beans.XPropertySet xPropSet = null;
-        unoidl.com.sun.star.table.XCell xCell = null;
-        unoidl.com.sun.star.table.XCellRange xCellRange = null;
-
-        // *** Access and modify a VALUE CELL ***
-        Console.WriteLine( "*** Sample for service table.Cell ***" );
-
-        xCell = xSheet.getCellByPosition( 0, 0 );
-        // Set cell value.
-        xCell.setValue( 1234 );
-
-        // Get cell value.
-        double nDblValue = xCell.getValue() * 2;
-        xSheet.getCellByPosition( 0, 1 ).setValue( nDblValue );
-
-        // *** Create a FORMULA CELL and query error type ***
-        xCell = xSheet.getCellByPosition( 0, 2 );
-        // Set formula string.
-        xCell.setFormula( "=1/0" );
-
-        // Get error type.
-        bool bValid = (xCell.getError() == 0);
-        // Get formula string.
-        String aText = "The formula " + xCell.getFormula() + " is ";
-        aText += bValid ? "valid." : "erroneous.";
-
-        // *** Insert a TEXT CELL using the XText interface ***
-        xCell = xSheet.getCellByPosition( 0, 3 );
-        unoidl.com.sun.star.text.XText xCellText =
-            (unoidl.com.sun.star.text.XText) xCell;
-        unoidl.com.sun.star.text.XTextCursor xTextCursor =
-            xCellText.createTextCursor();
-        xCellText.insertString( xTextCursor, aText, false );
-
-        // *** Change cell properties ***
-        int nValue = bValid ? 0x00FF00 : 0xFF4040;
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCell;
-        xPropSet.setPropertyValue(
-            "CellBackColor", new uno.Any( (Int32) nValue ) );
-
-
-        // *** Accessing a CELL RANGE ***
-        Console.WriteLine( "*** Sample for service table.CellRange ***" );
-
-        // Accessing a cell range over its position.
-        xCellRange = xSheet.getCellRangeByPosition( 2, 0, 3, 1 );
-
-        // Change properties of the range.
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCellRange;
-        xPropSet.setPropertyValue(
-            "CellBackColor", new uno.Any( (Int32) 0x8080FF ) );
-
-        // Accessing a cell range over its name.
-        xCellRange = xSheet.getCellRangeByName( "C4:D5" );
-
-        // Change properties of the range.
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCellRange;
-        xPropSet.setPropertyValue(
-            "CellBackColor", new uno.Any( (Int32) 0xFFFF80 ) );
-
-
-        // *** Using the CELL CURSOR to add some data below of
-        // the filled area ***
-        Console.WriteLine( "*** Sample for service table.CellCursor ***" );
-
-        // Create a cursor using the XSpreadsheet method createCursorByRange()
-        xCellRange = xSheet.getCellRangeByName( "A1" );
-        unoidl.com.sun.star.sheet.XSheetCellRange xSheetCellRange =
-            (unoidl.com.sun.star.sheet.XSheetCellRange) xCellRange;
-
-        unoidl.com.sun.star.sheet.XSheetCellCursor xSheetCellCursor =
-            xSheet.createCursorByRange( xSheetCellRange );
-        unoidl.com.sun.star.table.XCellCursor xCursor =
-            (unoidl.com.sun.star.table.XCellCursor) xSheetCellCursor;
-
-        // Move to the last filled cell.
-        xCursor.gotoEnd();
-        // Move one row down.
-        xCursor.gotoOffset( 0, 1 );
-        xCursor.getCellByPosition( 0, 0 ).setFormula(
-            "Beyond of the last filled cell." );
-
-
-        // *** Modifying COLUMNS and ROWS ***
-        Console.WriteLine( "*** Sample for services table.TableRows and " +
-                           "table.TableColumns ***" );
-
-        unoidl.com.sun.star.table.XColumnRowRange xCRRange =
-            (unoidl.com.sun.star.table.XColumnRowRange) xSheet;
-        unoidl.com.sun.star.table.XTableColumns xColumns =
-            xCRRange.getColumns();
-        unoidl.com.sun.star.table.XTableRows xRows = xCRRange.getRows();
-
-        // Get column C by index (interface XIndexAccess).
-        uno.Any aColumnObj = xColumns.getByIndex( 2 );
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) aColumnObj.Value;
-        xPropSet.setPropertyValue( "Width", new uno.Any( (Int32) 5000 ) );
-
-        // Get the name of the column.
-        unoidl.com.sun.star.container.XNamed xNamed =
-            (unoidl.com.sun.star.container.XNamed) aColumnObj.Value;
-        aText = "The name of this column is " + xNamed.getName() + ".";
-        xSheet.getCellByPosition( 2, 2 ).setFormula( aText );
-
-        // Get column D by name (interface XNameAccess).
-        unoidl.com.sun.star.container.XNameAccess xColumnsName =
-            (unoidl.com.sun.star.container.XNameAccess) xColumns;
-
-        aColumnObj = xColumnsName.getByName( "D" );
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) aColumnObj.Value;
-        xPropSet.setPropertyValue(
-            "IsVisible", new uno.Any( (Boolean) false ) );
-
-        // Get row 7 by index (interface XIndexAccess)
-        uno.Any aRowObj = xRows.getByIndex( 6 );
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) aRowObj.Value;
-        xPropSet.setPropertyValue( "Height", new uno.Any( (Int32) 5000 ) );
-
-        xSheet.getCellByPosition( 2, 6 ).setFormula( "What a big cell." );
-
-        // Create a cell series with the values 1 ... 7.
-        for (int nRow = 8; nRow < 15; ++nRow)
-            xSheet.getCellByPosition( 0, nRow ).setValue( nRow - 7 );
-        // Insert a row between 1 and 2
-        xRows.insertByIndex( 9, 1 );
-        // Delete the rows with the values 3 and 4.
-        xRows.removeByIndex( 11, 2 );
-
-        // *** Inserting CHARTS ***
-        Console.WriteLine( "*** Sample for service table.TableCharts ***" );
-
-        unoidl.com.sun.star.table.XTableChartsSupplier xChartsSupp =
-            (unoidl.com.sun.star.table.XTableChartsSupplier) xSheet;
-        unoidl.com.sun.star.table.XTableCharts xCharts =
-            xChartsSupp.getCharts();
-
-        // The chart will base on the last cell series, initializing all values.
-        String aName = "newChart";
-        unoidl.com.sun.star.awt.Rectangle aRect =
-            new unoidl.com.sun.star.awt.Rectangle();
-        aRect.X = 10000;
-        aRect.Y = 3000;
-        aRect.Width = aRect.Height = 5000;
-        unoidl.com.sun.star.table.CellRangeAddress[] aRanges =
-            new unoidl.com.sun.star.table.CellRangeAddress[1];
-        aRanges[0] = createCellRangeAddress( xSheet, "A9:A14" );
-
-        // Create the chart.
-        xCharts.addNewByName( aName, aRect, aRanges, false, false );
-
-        // Get the chart by name.
-        uno.Any aChartObj = xCharts.getByName( aName );
-        unoidl.com.sun.star.table.XTableChart xChart =
-            (unoidl.com.sun.star.table.XTableChart) aChartObj.Value;
-
-        // Query the state of row and column headers.
-        aText = "Chart has column headers: ";
-        aText += xChart.getHasColumnHeaders() ? "yes" : "no";
-        xSheet.getCellByPosition( 2, 8 ).setFormula( aText );
-        aText = "Chart has row headers: ";
-        aText += xChart.getHasRowHeaders() ? "yes" : "no";
-        xSheet.getCellByPosition( 2, 9 ).setFormula( aText );
-    }
-
-}
diff --git a/test/mono/Makefile b/test/mono/Makefile
deleted file mode 100644
index df6c0613d..000000000
--- a/test/mono/Makefile
+++ /dev/null
@@ -1,16 +0,0 @@
-SOURCES=GeneralTableSample.cs \
-	SpreadsheetDocHelper.cs \
-	SpreadsheetSample.cs \
-	ViewSample.cs
-
-all:	test
-
-test:	SpreadsheetSample.exe
-	mono --debug SpreadsheetSample.exe
-
-SpreadsheetSample.exe: ${SOURCES}
-	mcs -debug SpreadsheetSample.cs SpreadsheetDocHelper.cs \
-	    `pkg-config --libs mono-ooo-3.0`
-
-clean:
-	rm -f SpreadsheetSample.exe
diff --git a/test/mono/README b/test/mono/README
deleted file mode 100644
index cc23ac7fa..000000000
--- a/test/mono/README
+++ /dev/null
@@ -1,26 +0,0 @@
-This directory includes a small sample to test the mono bridge. It opens OOo
-Calc and puts some stuff into the first sheet. It should be enough to call:
-
-	make
-
-The .cs files are taken from the OOo sources:
-
-	odk/examples/CLI/CSharp/Spreadsheet/*.cs
-
-
-You can redistribute it and/or modify it under the terms of
-the GNU Lesser General Public License version 2.1,
-as published by the Free Software Foundation.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston,
-MA  02111-1307  USA
-
-
-						Happy testing!
diff --git a/test/mono/SpreadsheetDocHelper.cs b/test/mono/SpreadsheetDocHelper.cs
deleted file mode 100644
index c2122e809..000000000
--- a/test/mono/SpreadsheetDocHelper.cs
+++ /dev/null
@@ -1,352 +0,0 @@
-
-using System;
-using unoidl.com.sun.star.lang;
-using unoidl.com.sun.star.uno;
-using unoidl.com.sun.star.bridge;
-using unoidl.com.sun.star.frame;
-
-// __________  implementation  ____________________________________
-
-/** This is a helper class for the spreadsheet and table samples.
-    It connects to a running office and creates a spreadsheet document.
-    Additionally it contains various helper functions.
- */
-public class SpreadsheetDocHelper : System.IDisposable
-{
-
-// __  private members  ___________________________________________
-
-    private const String  msDataSheetName  = "Data";
-
-    private unoidl.com.sun.star.uno.XComponentContext m_xContext;
-    private unoidl.com.sun.star.lang.XMultiServiceFactory  mxMSFactory;
-    private unoidl.com.sun.star.sheet.XSpreadsheetDocument mxDocument;
-
-// ________________________________________________________________
-
-    public SpreadsheetDocHelper( String[] args )
-    {
-        // Connect to a running office and get the service manager
-        mxMSFactory = connect( args );
-        // Create a new spreadsheet document
-	try {
-	    mxDocument = initDocument();
-	} catch {
-	    Console.WriteLine("Error: unable to properly initialize document! That\n" +
-	        "usually happens when UNO bootstrap went wrong. Please check that soffice\n" +
-	        "binary in your path points to right OOo installation or use UNO_PATH\n" +
-		"environment variable to set path to your soffice binary.");
-	    Environment.Exit(1);
-	}
-    }
-
-// __  helper methods  ____________________________________________
-
-    /** Returns the service manager.
-        @return  XMultiServiceFactory interface of the service manager. */
-    public unoidl.com.sun.star.lang.XMultiServiceFactory getServiceManager()
-    {
-        return mxMSFactory;
-    }
-
-    /** Returns the whole spreadsheet document.
-        @return  XSpreadsheetDocument interface of the document. */
-    public unoidl.com.sun.star.sheet.XSpreadsheetDocument getDocument()
-    {
-        return mxDocument;
-    }
-
-    /** Returns the spreadsheet with the specified index (0-based).
-        @param nIndex  The index of the sheet.
-        @return  XSpreadsheet interface of the sheet. */
-    public unoidl.com.sun.star.sheet.XSpreadsheet getSpreadsheet( int nIndex )
-    {
-        // Collection of sheets
-        unoidl.com.sun.star.sheet.XSpreadsheets xSheets =
-            mxDocument.getSheets();
-        
-        unoidl.com.sun.star.container.XIndexAccess xSheetsIA =
-            (unoidl.com.sun.star.container.XIndexAccess) xSheets;
-        
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet =
-            (unoidl.com.sun.star.sheet.XSpreadsheet)
-              xSheetsIA.getByIndex( nIndex ).Value;
-        
-        return xSheet;
-    }
-
-    /** Inserts a new empty spreadsheet with the specified name.
-        @param aName  The name of the new sheet.
-        @param nIndex  The insertion index.
-        @return  The XSpreadsheet interface of the new sheet. */
-    public unoidl.com.sun.star.sheet.XSpreadsheet insertSpreadsheet(
-        String aName, short nIndex )
-    {
-        // Collection of sheets
-        unoidl.com.sun.star.sheet.XSpreadsheets xSheets =
-            mxDocument.getSheets();
-        
-        xSheets.insertNewByName( aName, nIndex );
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet =
-            (unoidl.com.sun.star.sheet.XSpreadsheet)
-              xSheets.getByName( aName ).Value;
-        
-        return xSheet;
-    }
-
-// ________________________________________________________________
-// Methods to fill values into cells.
-
-    /** Writes a double value into a spreadsheet.
-        @param xSheet  The XSpreadsheet interface of the spreadsheet.
-        @param aCellName  The address of the cell (or a named range).
-        @param fValue  The value to write into the cell. */
-    public void setValue(
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet,
-        String aCellName,
-        double fValue )
-    {
-        xSheet.getCellRangeByName( aCellName ).getCellByPosition(
-            0, 0 ).setValue( fValue );
-    }
-
-    /** Writes a formula into a spreadsheet.
-        @param xSheet  The XSpreadsheet interface of the spreadsheet.
-        @param aCellName  The address of the cell (or a named range).
-        @param aFormula  The formula to write into the cell. */
-    public void setFormula(
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet,
-        String aCellName,
-        String aFormula )
-    {
-        xSheet.getCellRangeByName( aCellName ).getCellByPosition(
-            0, 0 ).setFormula( aFormula );
-    }
-
-    /** Writes a date with standard date format into a spreadsheet.
-        @param xSheet  The XSpreadsheet interface of the spreadsheet.
-        @param aCellName  The address of the cell (or a named range).
-        @param nDay  The day of the date.
-        @param nMonth  The month of the date.
-        @param nYear  The year of the date. */
-    public void setDate(
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet,
-        String aCellName,
-        int nDay, int nMonth, int nYear )
-    {
-        // Set the date value.
-        unoidl.com.sun.star.table.XCell xCell =
-            xSheet.getCellRangeByName( aCellName ).getCellByPosition( 0, 0 );
-        String aDateStr = nMonth + "/" + nDay + "/" + nYear;
-        xCell.setFormula( aDateStr );
-
-        // Set standard date format.
-        unoidl.com.sun.star.util.XNumberFormatsSupplier xFormatsSupplier =
-            (unoidl.com.sun.star.util.XNumberFormatsSupplier) getDocument();
-        unoidl.com.sun.star.util.XNumberFormatTypes xFormatTypes =
-            (unoidl.com.sun.star.util.XNumberFormatTypes)
-              xFormatsSupplier.getNumberFormats();
-        int nFormat = xFormatTypes.getStandardFormat(
-            unoidl.com.sun.star.util.NumberFormat.DATE,
-            new unoidl.com.sun.star.lang.Locale() );
-
-        unoidl.com.sun.star.beans.XPropertySet xPropSet =
-            (unoidl.com.sun.star.beans.XPropertySet) xCell;
-        xPropSet.setPropertyValue(
-            "NumberFormat",
-            new uno.Any( (Int32) nFormat ) );
-    }
-
-    /** Draws a colored border around the range and writes the headline
-        in the first cell.
-        
-        @param xSheet  The XSpreadsheet interface of the spreadsheet.
-        @param aRange  The address of the cell range (or a named range).
-        @param aHeadline  The headline text. */
-    public void prepareRange(
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet,
-        String aRange, String aHeadline )
-    {
-        unoidl.com.sun.star.beans.XPropertySet xPropSet = null;
-        unoidl.com.sun.star.table.XCellRange xCellRange = null;
-        
-        // draw border
-        xCellRange = xSheet.getCellRangeByName( aRange );
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCellRange;
-        unoidl.com.sun.star.table.BorderLine aLine =
-            new unoidl.com.sun.star.table.BorderLine();
-        aLine.Color = 0x99CCFF;
-        aLine.InnerLineWidth = aLine.LineDistance = 0;
-        aLine.OuterLineWidth = 100;
-        unoidl.com.sun.star.table.TableBorder aBorder =
-            new unoidl.com.sun.star.table.TableBorder();
-        aBorder.TopLine = aBorder.BottomLine = aBorder.LeftLine =
-            aBorder.RightLine = aLine;
-        aBorder.IsTopLineValid = aBorder.IsBottomLineValid = true;
-        aBorder.IsLeftLineValid = aBorder.IsRightLineValid = true;
-        xPropSet.setPropertyValue(
-            "TableBorder",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.table.TableBorder), aBorder ) );
-
-        // draw headline
-        unoidl.com.sun.star.sheet.XCellRangeAddressable xAddr =
-            (unoidl.com.sun.star.sheet.XCellRangeAddressable) xCellRange;
-        unoidl.com.sun.star.table.CellRangeAddress aAddr =
-            xAddr.getRangeAddress();
-
-        xCellRange = xSheet.getCellRangeByPosition(
-            aAddr.StartColumn,
-            aAddr.StartRow, aAddr.EndColumn, aAddr.StartRow );
-        
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCellRange;
-        xPropSet.setPropertyValue(
-            "CellBackColor", new uno.Any( (Int32) 0x99CCFF ) );
-        // write headline
-        unoidl.com.sun.star.table.XCell xCell =
-            xCellRange.getCellByPosition( 0, 0 );
-        xCell.setFormula( aHeadline );
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCell;
-        xPropSet.setPropertyValue(
-            "CharColor", new uno.Any( (Int32) 0x003399 ) );
-        xPropSet.setPropertyValue(
-            "CharWeight",
-            new uno.Any( (Single) unoidl.com.sun.star.awt.FontWeight.BOLD ) );
-    }
-
-// ________________________________________________________________
-// Methods to create cell addresses and range addresses.
-
-    /** Creates a unoidl.com.sun.star.table.CellAddress and initializes it
-        with the given range.
-        @param xSheet  The XSpreadsheet interface of the spreadsheet.
-        @param aCell  The address of the cell (or a named cell). */
-    public unoidl.com.sun.star.table.CellAddress createCellAddress(
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet,
-        String aCell )
-    {
-        unoidl.com.sun.star.sheet.XCellAddressable xAddr =
-        (unoidl.com.sun.star.sheet.XCellAddressable)
-            xSheet.getCellRangeByName( aCell ).getCellByPosition( 0, 0 );
-        return xAddr.getCellAddress();
-    }
-
-    /** Creates a unoidl.com.sun.star.table.CellRangeAddress and initializes
-        it with the given range.
-        @param xSheet  The XSpreadsheet interface of the spreadsheet.
-        @param aRange  The address of the cell range (or a named range). */
-    public unoidl.com.sun.star.table.CellRangeAddress createCellRangeAddress(
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet, String aRange )
-    {
-        unoidl.com.sun.star.sheet.XCellRangeAddressable xAddr =
-            (unoidl.com.sun.star.sheet.XCellRangeAddressable)
-            xSheet.getCellRangeByName( aRange );
-        return xAddr.getRangeAddress();
-    }
-
-// ________________________________________________________________
-// Methods to convert cell addresses and range addresses to strings.
-
-    /** Returns the text address of the cell.
-        @param nColumn  The column index.
-        @param nRow  The row index.
-        @return  A string containing the cell address. */
-    public String getCellAddressString( int nColumn, int nRow )
-    {
-        String aStr = "";
-        if (nColumn > 25)
-            aStr += (char) ('A' + nColumn / 26 - 1);
-        aStr += (char) ('A' + nColumn % 26);
-        aStr += (nRow + 1);
-        return aStr;
-    }
-
-    /** Returns the text address of the cell range.
-        @param aCellRange  The cell range address.
-        @return  A string containing the cell range address. */
-    public String getCellRangeAddressString(
-        unoidl.com.sun.star.table.CellRangeAddress aCellRange )
-    {
-        return
-            getCellAddressString( aCellRange.StartColumn, aCellRange.StartRow )
-            + ":"
-            + getCellAddressString( aCellRange.EndColumn, aCellRange.EndRow );
-    }
-
-    /** Returns the text address of the cell range.
-        @param xCellRange  The XSheetCellRange interface of the cell range.
-        @param bWithSheet  true = Include sheet name.
-        @return  A string containing the cell range address. */
-    public String getCellRangeAddressString(
-        unoidl.com.sun.star.sheet.XSheetCellRange xCellRange, bool bWithSheet )
-    {
-        String aStr = "";
-        if (bWithSheet)
-        {
-            unoidl.com.sun.star.sheet.XSpreadsheet xSheet =
-                xCellRange.getSpreadsheet();
-            unoidl.com.sun.star.container.XNamed xNamed =
-                (unoidl.com.sun.star.container.XNamed) xSheet;
-            aStr += xNamed.getName() + ".";
-        }
-        unoidl.com.sun.star.sheet.XCellRangeAddressable xAddr =
-            (unoidl.com.sun.star.sheet.XCellRangeAddressable) xCellRange;
-        aStr += getCellRangeAddressString( xAddr.getRangeAddress() );
-        return aStr;
-    }
-
-    /** Returns a list of addresses of all cell ranges contained in the
-        collection.
-        
-        @param xRangesIA  The XIndexAccess interface of the collection.
-        @return  A string containing the cell range address list. */
-    public String getCellRangeListString(
-        unoidl.com.sun.star.container.XIndexAccess xRangesIA )
-    {
-        String aStr = "";
-        int nCount = xRangesIA.getCount();
-        for (int nIndex = 0; nIndex < nCount; ++nIndex)
-        {
-            if (nIndex > 0)
-                aStr += " ";
-            uno.Any aRangeObj = xRangesIA.getByIndex( nIndex );
-            unoidl.com.sun.star.sheet.XSheetCellRange xCellRange =
-                (unoidl.com.sun.star.sheet.XSheetCellRange) aRangeObj.Value;
-            aStr += getCellRangeAddressString( xCellRange, false );
-        }
-        return aStr;
-    }
-
-// ________________________________________________________________
-
-    /** Connect to a running office that is accepting connections.
-        @return  The ServiceManager to instantiate office components. */
-    private XMultiServiceFactory connect( String [] args )
-    {
-        
-        m_xContext = uno.util.Bootstrap.bootstrap();
-        
-        return (XMultiServiceFactory) m_xContext.getServiceManager();
-    }
-
-    public void Dispose()
-    {
-
-    }
-
-    /** Creates an empty spreadsheet document.
-        @return  The XSpreadsheetDocument interface of the document. */
-    private unoidl.com.sun.star.sheet.XSpreadsheetDocument initDocument()
-    {
-        XComponentLoader aLoader = (XComponentLoader)
-            mxMSFactory.createInstance( "com.sun.star.frame.Desktop" );
-        
-        XComponent xComponent = aLoader.loadComponentFromURL(
-            "private:factory/scalc", "_blank", 0,
-            new unoidl.com.sun.star.beans.PropertyValue[0] );
-
-        return (unoidl.com.sun.star.sheet.XSpreadsheetDocument) xComponent;
-    }
-
-// ________________________________________________________________
-}
diff --git a/test/mono/SpreadsheetSample b/test/mono/SpreadsheetSample
deleted file mode 100755
index d4c38a9cb..000000000
--- a/test/mono/SpreadsheetSample
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/bin/sh
-
-# Starts the SpreadsheetSample.exe from the <ooo-home>/program directory
-# It should not be needed any longer. The sample should work from
-# anywhere just by running:
-#
-#	mono $sample_dir/SpreadsheetSample.exe
-
-soffice_link=`which soffice`
-soffice_path=`readlink -f $soffice_link`
-ooo_program_dir=$(dirname $soffice_path)
-
-
-# FIXME: It does not work using the LD_LIBRARY_PATH
-#        We have chnage directory to $ooo_program_dir"
-# export LD_LIBRARY_PATH="$LD_LIBRARY_PATH:$ooo_program_dir"
-
-sample_dir=`pwd`
-cd $ooo_program_dir
-pwd
-echo mono $sample_dir/SpreadsheetSample.exe
-mono $sample_dir/SpreadsheetSample.exe
-cd -
-
diff --git a/test/mono/SpreadsheetSample.cs b/test/mono/SpreadsheetSample.cs
deleted file mode 100644
index 34ea967fe..000000000
--- a/test/mono/SpreadsheetSample.cs
+++ /dev/null
@@ -1,1478 +0,0 @@
-
-using System;
-
-// __________  implementation  ____________________________________
-
-/** Create and modify a spreadsheet document.
- */
-public class SpreadsheetSample : SpreadsheetDocHelper
-{
-
-    public static void Main( String [] args )
-    {
-        try
-        {
-            using ( SpreadsheetSample aSample = new SpreadsheetSample( args ) )
-            {
-                aSample.doSampleFunctions();
-            }
-            Console.WriteLine( "\nSamples done." );
-        }
-        catch (Exception ex)
-        {
-            Console.WriteLine( "Sample caught exception! " + ex );
-        }
-    }
-
-    public SpreadsheetSample( String[] args )
-        : base( args )
-    {
-    }
-    
-    /** This sample function performs all changes on the document. */
-    public void doSampleFunctions()
-    {
-        doCellSamples();
-        doCellRangeSamples();
-        doCellRangesSamples();
-        doCellCursorSamples();
-        doFormattingSamples();
-        doDocumentSamples();
-        doDatabaseSamples();
-        doDataPilotSamples();
-        doNamedRangesSamples();
-        doFunctionAccessSamples();
-        doApplicationSettingsSamples();
-    }
-
-// ________________________________________________________________
-
-    /** All samples regarding the service com.sun.star.sheet.SheetCell. */
-    private void doCellSamples()
-    {
-        Console.WriteLine( "\n*** Samples for service sheet.SheetCell ***\n" );
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet = getSpreadsheet( 0 );
-        unoidl.com.sun.star.table.XCell xCell = null;
-        unoidl.com.sun.star.beans.XPropertySet xPropSet = null;
-        String aText;
-        prepareRange( xSheet, "A1:C7", "Cells and Cell Ranges" );
-
-        // --- Get cell B3 by position - (column, row) ---
-        xCell = xSheet.getCellByPosition( 1, 2 );
-
-        // --- Insert two text paragraphs into the cell. ---
-        unoidl.com.sun.star.text.XText xText =
-            (unoidl.com.sun.star.text.XText) xCell;
-        unoidl.com.sun.star.text.XTextCursor xTextCursor =
-            xText.createTextCursor();
-
-        xText.insertString( xTextCursor, "Text in first line.", false );
-        xText.insertControlCharacter( xTextCursor,
-            unoidl.com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, false );
-        xText.insertString( xTextCursor, "And a ", false );
-
-        // create a hyperlink
-        unoidl.com.sun.star.lang.XMultiServiceFactory xServiceMan =
-            (unoidl.com.sun.star.lang.XMultiServiceFactory) getDocument();
-        Object aHyperlinkObj =
-            xServiceMan.createInstance( "com.sun.star.text.TextField.URL" );
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) aHyperlinkObj;
-        xPropSet.setPropertyValue(
-            "URL", new uno.Any( "http://www.example.org" ) );
-        xPropSet.setPropertyValue(
-            "Representation", new uno.Any( "hyperlink" ) );
-        // ... and insert
-        unoidl.com.sun.star.text.XTextContent xContent =
-            (unoidl.com.sun.star.text.XTextContent) aHyperlinkObj;
-        xText.insertTextContent( xTextCursor, xContent, false );
-        
-        // --- Query the separate paragraphs. ---
-        unoidl.com.sun.star.container.XEnumerationAccess xParaEA =
-            (unoidl.com.sun.star.container.XEnumerationAccess) xCell;
-        unoidl.com.sun.star.container.XEnumeration xParaEnum =
-            xParaEA.createEnumeration();
-        // Go through the paragraphs
-        while( xParaEnum.hasMoreElements() )
-        {
-            uno.Any aPortionObj = xParaEnum.nextElement();
-            unoidl.com.sun.star.container.XEnumerationAccess xPortionEA =
-                (unoidl.com.sun.star.container.XEnumerationAccess)
-                aPortionObj.Value;
-            unoidl.com.sun.star.container.XEnumeration xPortionEnum =
-                xPortionEA.createEnumeration();
-            aText = "";
-            // Go through all text portions of a paragraph and construct string.
-            while( xPortionEnum.hasMoreElements() )
-            {
-                unoidl.com.sun.star.text.XTextRange xRange =
-                    (unoidl.com.sun.star.text.XTextRange)
-                    xPortionEnum.nextElement().Value;
-                aText += xRange.getString();
-            }
-            Console.WriteLine( "Paragraph text: " + aText );
-        }
-        
-        
-        // --- Change cell properties. ---
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCell;
-        // from styles.CharacterProperties
-        xPropSet.setPropertyValue(
-            "CharColor", new uno.Any( (Int32) 0x003399 ) );
-        xPropSet.setPropertyValue(
-            "CharHeight", new uno.Any( (Single) 20.0 ) );
-        // from styles.ParagraphProperties
-        xPropSet.setPropertyValue(
-            "ParaLeftMargin", new uno.Any( (Int32) 500 ) );
-        // from table.CellProperties
-        xPropSet.setPropertyValue(
-            "IsCellBackgroundTransparent", new uno.Any( false ) );
-        xPropSet.setPropertyValue(
-            "CellBackColor", new uno.Any( (Int32) 0x99CCFF ) );
-        
-        
-        // --- Get cell address. ---
-        unoidl.com.sun.star.sheet.XCellAddressable xCellAddr =
-            (unoidl.com.sun.star.sheet.XCellAddressable) xCell;
-        unoidl.com.sun.star.table.CellAddress aAddress =
-            xCellAddr.getCellAddress();
-        aText = "Address of this cell:  Column=" + aAddress.Column;
-        aText += ";  Row=" + aAddress.Row;
-        aText += ";  Sheet=" + aAddress.Sheet;
-        Console.WriteLine( aText );
-    
-    
-        // --- Insert an annotation ---
-        unoidl.com.sun.star.sheet.XSheetAnnotationsSupplier xAnnotationsSupp =
-        (unoidl.com.sun.star.sheet.XSheetAnnotationsSupplier) xSheet;
-        unoidl.com.sun.star.sheet.XSheetAnnotations xAnnotations =
-            xAnnotationsSupp.getAnnotations();
-        xAnnotations.insertNew( aAddress, "This is an annotation" );
-
-        unoidl.com.sun.star.sheet.XSheetAnnotationAnchor xAnnotAnchor =
-            (unoidl.com.sun.star.sheet.XSheetAnnotationAnchor) xCell;
-        unoidl.com.sun.star.sheet.XSheetAnnotation xAnnotation =
-            xAnnotAnchor.getAnnotation();
-        xAnnotation.setIsVisible( true );
-    }
-
-// ________________________________________________________________
-
-    /** All samples regarding the service com.sun.star.sheet.SheetCellRange. */
-    private void doCellRangeSamples()
-    {
-        Console.WriteLine(
-            "\n*** Samples for service sheet.SheetCellRange ***\n" );
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet = getSpreadsheet( 0 );
-        unoidl.com.sun.star.table.XCellRange xCellRange = null;
-        unoidl.com.sun.star.beans.XPropertySet xPropSet = null;
-        unoidl.com.sun.star.table.CellRangeAddress aRangeAddress = null;
-
-        // Preparation
-        setFormula( xSheet, "B5", "First cell" );
-        setFormula( xSheet, "B6", "Second cell" );
-        // Get cell range B5:B6 by position - (column, row, column, row)
-        xCellRange = xSheet.getCellRangeByPosition( 1, 4, 1, 5 );
-
-
-        // --- Change cell range properties. ---
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCellRange;
-        // from com.sun.star.styles.CharacterProperties
-        xPropSet.setPropertyValue(
-            "CharColor", new uno.Any( (Int32) 0x003399 ) );
-        xPropSet.setPropertyValue(
-            "CharHeight", new uno.Any( (Single) 20.0 ) );
-        // from com.sun.star.styles.ParagraphProperties
-        xPropSet.setPropertyValue(
-            "ParaLeftMargin", new uno.Any( (Int32) 500 ) );
-        // from com.sun.star.table.CellProperties
-        xPropSet.setPropertyValue(
-            "IsCellBackgroundTransparent", new uno.Any( false ) );
-        xPropSet.setPropertyValue(
-            "CellBackColor", new uno.Any( (Int32) 0x99CCFF ) );
-
-
-        // --- Replace text in all cells. ---
-        unoidl.com.sun.star.util.XReplaceable xReplace =
-            (unoidl.com.sun.star.util.XReplaceable) xCellRange;
-        unoidl.com.sun.star.util.XReplaceDescriptor xReplaceDesc =
-            xReplace.createReplaceDescriptor();
-        xReplaceDesc.setSearchString( "cell" );
-        xReplaceDesc.setReplaceString( "text" );
-        // property SearchWords searches for whole cells!
-        xReplaceDesc.setPropertyValue( "SearchWords", new uno.Any( false ) );
-        int nCount = xReplace.replaceAll( xReplaceDesc );
-        Console.WriteLine( "Search text replaced " + nCount + " times." );
-
-
-        // --- Merge cells. ---
-        xCellRange = xSheet.getCellRangeByName( "F3:G6" );
-        prepareRange( xSheet, "E1:H7", "XMergeable" );
-        unoidl.com.sun.star.util.XMergeable xMerge =
-            (unoidl.com.sun.star.util.XMergeable) xCellRange;
-        xMerge.merge( true );
-
-
-        // --- Change indentation. ---
-/* does not work (bug in XIndent implementation)
-        prepareRange( xSheet, "I20:I23", "XIndent" );
-        setValue( xSheet, "I21", 1 );
-        setValue( xSheet, "I22", 1 );
-        setValue( xSheet, "I23", 1 );
-
-        xCellRange = xSheet.getCellRangeByName( "I21:I22" );
-        unoidl.com.sun.star.util.XIndent xIndent =
-        (unoidl.com.sun.star.util.XIndent) xCellRange;
-        xIndent.incrementIndent();
-
-        xCellRange = xSheet.getCellRangeByName( "I22:I23" );
-        xIndent = (unoidl.com.sun.star.util.XIndent) xCellRange;
-        xIndent.incrementIndent();
-*/
-
-
-        // --- Column properties. ---
-        xCellRange = xSheet.getCellRangeByName( "B1" );
-        unoidl.com.sun.star.table.XColumnRowRange xColRowRange =
-            (unoidl.com.sun.star.table.XColumnRowRange) xCellRange;
-        unoidl.com.sun.star.table.XTableColumns xColumns =
-            xColRowRange.getColumns();
-
-        uno.Any aColumnObj = xColumns.getByIndex( 0 );
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) aColumnObj.Value;
-        xPropSet.setPropertyValue( "Width", new uno.Any( (Int32) 6000 ) );
-
-        unoidl.com.sun.star.container.XNamed xNamed =
-            (unoidl.com.sun.star.container.XNamed) aColumnObj.Value;
-        Console.WriteLine(
-            "The name of the wide column is " + xNamed.getName() + "." );
-
-
-        // --- Cell range data ---
-        prepareRange( xSheet, "A9:C30", "XCellRangeData" );
-
-        xCellRange = xSheet.getCellRangeByName( "A10:C30" );
-        unoidl.com.sun.star.sheet.XCellRangeData xData =
-            (unoidl.com.sun.star.sheet.XCellRangeData) xCellRange;
-        uno.Any [][] aValues =
-        {
-            new uno.Any [] { new uno.Any( "Name" ),
-                             new uno.Any( "Fruit" ),
-                             new uno.Any( "Quantity" ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Apples" ),
-                             new uno.Any( (Double) 3.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Oranges" ),
-                             new uno.Any( (Double) 7.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( "Apples" ),
-                             new uno.Any( (Double) 3.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Apples" ),
-                             new uno.Any( (Double) 9.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( "Apples" ),
-                             new uno.Any( (Double) 5.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( "Oranges" ),
-                             new uno.Any( (Double) 6.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Oranges" ),
-                             new uno.Any( (Double) 3.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Apples" ),
-                             new uno.Any( (Double) 8.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Oranges" ),
-                             new uno.Any( (Double) 1.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( "Oranges" ),
-                             new uno.Any( (Double) 2.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( "Oranges" ),
-                             new uno.Any( (Double) 7.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( "Apples" ),
-                             new uno.Any( (Double) 1.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Apples" ),
-                             new uno.Any( (Double) 8.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Oranges" ),
-                             new uno.Any( (Double) 8.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Apples" ),
-                             new uno.Any( (Double) 7.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( "Apples" ),
-                             new uno.Any( (Double) 1.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( "Oranges" ),
-                             new uno.Any( (Double) 9.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( "Oranges" ),
-                             new uno.Any( (Double) 3.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Oranges" ),
-                             new uno.Any( (Double) 4.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( "Apples" ),
-                             new uno.Any( (Double) 9.0 ) }
-        };
-        xData.setDataArray( aValues );
-
-
-        // --- Get cell range address. ---
-        unoidl.com.sun.star.sheet.XCellRangeAddressable xRangeAddr =
-            (unoidl.com.sun.star.sheet.XCellRangeAddressable) xCellRange;
-        aRangeAddress = xRangeAddr.getRangeAddress();
-        Console.WriteLine(
-            "Address of this range:  Sheet=" + aRangeAddress.Sheet );
-        Console.WriteLine(
-            "Start column=" + aRangeAddress.StartColumn + ";  Start row=" +
-            aRangeAddress.StartRow );
-        Console.WriteLine(
-            "End column  =" + aRangeAddress.EndColumn   + ";  End row  =" +
-            aRangeAddress.EndRow );
-
-
-        // --- Sheet operation. ---
-        // uses the range filled with XCellRangeData
-        unoidl.com.sun.star.sheet.XSheetOperation xSheetOp =
-            (unoidl.com.sun.star.sheet.XSheetOperation) xData;
-        double fResult = xSheetOp.computeFunction(
-            unoidl.com.sun.star.sheet.GeneralFunction.AVERAGE );
-        Console.WriteLine(
-            "Average value of the data table A10:C30: " + fResult );
-
-
-        // --- Fill series ---
-        // Prepare the example
-        setValue( xSheet, "E10", 1 );
-        setValue( xSheet, "E11", 4 );
-        setDate( xSheet, "E12", 30, 1, 2002 );
-        setFormula( xSheet, "I13", "Text 10" );
-        setFormula( xSheet, "E14", "Jan" );
-        setValue( xSheet, "K14", 10 );
-        setValue( xSheet, "E16", 1 );
-        setValue( xSheet, "F16", 2 );
-        setDate( xSheet, "E17", 28, 2, 2002 );
-        setDate( xSheet, "F17", 28, 1, 2002 );
-        setValue( xSheet, "E18", 6 );
-        setValue( xSheet, "F18", 4 );
-
-        unoidl.com.sun.star.sheet.XCellSeries xSeries = null;
-        // Fill 2 rows linear with end value
-        // -> 2nd series is not filled completely
-        xSeries = getCellSeries( xSheet, "E10:I11" );
-        xSeries.fillSeries(
-            unoidl.com.sun.star.sheet.FillDirection.TO_RIGHT,
-            unoidl.com.sun.star.sheet.FillMode.LINEAR,
-            unoidl.com.sun.star.sheet.FillDateMode.FILL_DATE_DAY, 2, 9 );
-        // Add months to a date
-        xSeries = getCellSeries( xSheet, "E12:I12" );
-        xSeries.fillSeries(
-            unoidl.com.sun.star.sheet.FillDirection.TO_RIGHT,
-            unoidl.com.sun.star.sheet.FillMode.DATE,
-            unoidl.com.sun.star.sheet.FillDateMode.FILL_DATE_MONTH,
-            1, 0x7FFFFFFF );
-        // Fill right to left with a text containing a value
-        xSeries = getCellSeries( xSheet, "E13:I13" );
-        xSeries.fillSeries(
-            unoidl.com.sun.star.sheet.FillDirection.TO_LEFT,
-            unoidl.com.sun.star.sheet.FillMode.LINEAR,
-            unoidl.com.sun.star.sheet.FillDateMode.FILL_DATE_DAY,
-            10, 0x7FFFFFFF );
-        // Fill with an user defined list
-        xSeries = getCellSeries( xSheet, "E14:I14" );
-        xSeries.fillSeries(
-            unoidl.com.sun.star.sheet.FillDirection.TO_RIGHT,
-            unoidl.com.sun.star.sheet.FillMode.AUTO,
-            unoidl.com.sun.star.sheet.FillDateMode.FILL_DATE_DAY,
-            1, 0x7FFFFFFF );
-        // Fill bottom to top with a geometric series
-        xSeries = getCellSeries( xSheet, "K10:K14" );
-        xSeries.fillSeries(
-            unoidl.com.sun.star.sheet.FillDirection.TO_TOP,
-            unoidl.com.sun.star.sheet.FillMode.GROWTH,
-            unoidl.com.sun.star.sheet.FillDateMode.FILL_DATE_DAY,
-            2, 0x7FFFFFFF );
-        // Auto fill
-        xSeries = getCellSeries( xSheet, "E16:K18" );
-        xSeries.fillAuto(
-            unoidl.com.sun.star.sheet.FillDirection.TO_RIGHT, 2 );
-        // Fill series copies cell formats -> draw border here
-        prepareRange( xSheet, "E9:K18", "XCellSeries" );
-
-
-        // --- Array formulas ---
-        xCellRange = xSheet.getCellRangeByName( "E21:G23" );
-        prepareRange( xSheet, "E20:G23", "XArrayFormulaRange" );
-        unoidl.com.sun.star.sheet.XArrayFormulaRange xArrayFormula =
-            (unoidl.com.sun.star.sheet.XArrayFormulaRange) xCellRange;
-        // Insert a 3x3 unit matrix.
-        xArrayFormula.setArrayFormula( "=A10:C12" );
-        Console.WriteLine(
-            "Array formula is: " + xArrayFormula.getArrayFormula() );
-
-
-        // --- Multiple operations ---
-        setFormula( xSheet, "E26", "=E27^F26" );
-        setValue( xSheet, "E27", 1 );
-        setValue( xSheet, "F26", 1 );
-        getCellSeries( xSheet, "E27:E31" ).fillAuto(
-            unoidl.com.sun.star.sheet.FillDirection.TO_BOTTOM, 1 );
-        getCellSeries( xSheet, "F26:J26" ).fillAuto(
-            unoidl.com.sun.star.sheet.FillDirection.TO_RIGHT, 1 );
-        setFormula( xSheet, "F33", "=SIN(E33)" );
-        setFormula( xSheet, "G33", "=COS(E33)" );
-        setFormula( xSheet, "H33", "=TAN(E33)" );
-        setValue( xSheet, "E34", 0 );
-        setValue( xSheet, "E35", 0.2 );
-        getCellSeries( xSheet, "E34:E38" ).fillAuto(
-            unoidl.com.sun.star.sheet.FillDirection.TO_BOTTOM, 2 );
-        prepareRange( xSheet, "E25:J38", "XMultipleOperation" );
-
-        unoidl.com.sun.star.table.CellRangeAddress aFormulaRange =
-            createCellRangeAddress( xSheet, "E26" );
-        unoidl.com.sun.star.table.CellAddress aColCell =
-            createCellAddress( xSheet, "E27" );
-        unoidl.com.sun.star.table.CellAddress aRowCell =
-            createCellAddress( xSheet, "F26" );
-
-        xCellRange = xSheet.getCellRangeByName( "E26:J31" );
-        unoidl.com.sun.star.sheet.XMultipleOperation xMultOp =
-            (unoidl.com.sun.star.sheet.XMultipleOperation) xCellRange;
-        xMultOp.setTableOperation(
-            aFormulaRange, unoidl.com.sun.star.sheet.TableOperationMode.BOTH,
-            aColCell, aRowCell );
-
-        aFormulaRange = createCellRangeAddress( xSheet, "F33:H33" );
-        aColCell = createCellAddress( xSheet, "E33" );
-        // Row cell not needed
-
-        xCellRange = xSheet.getCellRangeByName( "E34:H38" );
-        xMultOp = (unoidl.com.sun.star.sheet.XMultipleOperation) xCellRange;
-        xMultOp.setTableOperation(
-            aFormulaRange, unoidl.com.sun.star.sheet.TableOperationMode.COLUMN,
-            aColCell, aRowCell );
-
-
-        // --- Cell Ranges Query ---
-        xCellRange = xSheet.getCellRangeByName( "A10:C30" );
-        unoidl.com.sun.star.sheet.XCellRangesQuery xRangesQuery =
-            (unoidl.com.sun.star.sheet.XCellRangesQuery) xCellRange;
-        unoidl.com.sun.star.sheet.XSheetCellRanges xCellRanges =
-            xRangesQuery.queryContentCells(
-                (short) unoidl.com.sun.star.sheet.CellFlags.STRING );
-        Console.WriteLine(
-            "Cells in A10:C30 containing text: "
-            + xCellRanges.getRangeAddressesAsString() );
-    }
-
-    /** Returns the XCellSeries interface of a cell range.
-        @param xSheet  The spreadsheet containing the cell range.
-        @param aRange  The address of the cell range.
-        @return  The XCellSeries interface. */
-    private unoidl.com.sun.star.sheet.XCellSeries getCellSeries(
-            unoidl.com.sun.star.sheet.XSpreadsheet xSheet, String aRange )
-    {
-        return (unoidl.com.sun.star.sheet.XCellSeries)
-            xSheet.getCellRangeByName( aRange );
-    }
-
-// ________________________________________________________________
-
-    /** All samples regarding cell range collections. */
-    private void doCellRangesSamples()
-    {
-        Console.WriteLine( "\n*** Samples for cell range collections ***\n" );
-
-        // Create a new cell range container
-        unoidl.com.sun.star.lang.XMultiServiceFactory xDocFactory =
-            (unoidl.com.sun.star.lang.XMultiServiceFactory) getDocument();
-        unoidl.com.sun.star.sheet.XSheetCellRangeContainer xRangeCont =
-            (unoidl.com.sun.star.sheet.XSheetCellRangeContainer)
-            xDocFactory.createInstance(
-                "com.sun.star.sheet.SheetCellRanges" );
-
-
-        // --- Insert ranges ---
-        insertRange( xRangeCont, 0, 0, 0, 0, 0, false );    // A1:A1
-        insertRange( xRangeCont, 0, 0, 1, 0, 2, true );     // A2:A3
-        insertRange( xRangeCont, 0, 1, 0, 1, 2, false );    // B1:B3
-
-
-        // --- Query the list of filled cells ---
-        Console.WriteLine( "All filled cells: " );
-        unoidl.com.sun.star.container.XEnumerationAccess xCellsEA =
-            xRangeCont.getCells();
-        unoidl.com.sun.star.container.XEnumeration xEnum =
-            xCellsEA.createEnumeration();
-        while( xEnum.hasMoreElements() )
-        {
-            uno.Any aCellObj = xEnum.nextElement();
-            unoidl.com.sun.star.sheet.XCellAddressable xAddr =
-                (unoidl.com.sun.star.sheet.XCellAddressable) aCellObj.Value;
-            unoidl.com.sun.star.table.CellAddress aAddr =
-                xAddr.getCellAddress();
-            Console.WriteLine(
-                getCellAddressString( aAddr.Column, aAddr.Row ) + " " );
-        }
-        Console.WriteLine();
-    }
-
-    /** Inserts a cell range address into a cell range container and prints
-        a message.
-        @param xContainer  unoidl.com.sun.star.sheet.XSheetCellRangeContainer
-                           interface of the container.
-        @param nSheet  Index of sheet of the range.
-        @param nStartCol  Index of first column of the range.
-        @param nStartRow  Index of first row of the range.
-        @param nEndCol  Index of last column of the range.
-        @param nEndRow  Index of last row of the range.
-        @param bMerge  Determines whether the new range should be merged
-                       with the existing ranges.
-    */
-    private void insertRange(
-            unoidl.com.sun.star.sheet.XSheetCellRangeContainer xContainer,
-            int nSheet, int nStartCol, int nStartRow, int nEndCol, int nEndRow,
-            bool bMerge )
-    {
-        unoidl.com.sun.star.table.CellRangeAddress aAddress =
-            new unoidl.com.sun.star.table.CellRangeAddress();
-        aAddress.Sheet = (short)nSheet;
-        aAddress.StartColumn = nStartCol;
-        aAddress.StartRow = nStartRow;
-        aAddress.EndColumn = nEndCol;
-        aAddress.EndRow = nEndRow;
-        xContainer.addRangeAddress( aAddress, bMerge );
-        Console.WriteLine(
-            "Inserting " + getCellRangeAddressString( aAddress )
-            + " " + (bMerge ? "   with" : "without") + " merge,"
-            + " resulting list: " + xContainer.getRangeAddressesAsString() );
-    }
-
-// ________________________________________________________________
-
-    /** All samples regarding cell cursors. */
-    private void doCellCursorSamples()
-    {
-        Console.WriteLine( "\n*** Samples for cell cursor ***\n" );
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet = getSpreadsheet( 0 );
-
-
-        // --- Find the array formula using a cell cursor ---
-        unoidl.com.sun.star.table.XCellRange xRange =
-            xSheet.getCellRangeByName( "F22" );
-        unoidl.com.sun.star.sheet.XSheetCellRange xCellRange =
-            (unoidl.com.sun.star.sheet.XSheetCellRange) xRange;
-        unoidl.com.sun.star.sheet.XSheetCellCursor xCursor =
-            xSheet.createCursorByRange( xCellRange );
-
-        xCursor.collapseToCurrentArray();
-        unoidl.com.sun.star.sheet.XArrayFormulaRange xArray =
-            (unoidl.com.sun.star.sheet.XArrayFormulaRange) xCursor;
-        Console.WriteLine(
-            "Array formula in " + getCellRangeAddressString( xCursor, false )
-            + " contains formula " + xArray.getArrayFormula() );
-
-
-        // --- Find the used area ---
-        unoidl.com.sun.star.sheet.XUsedAreaCursor xUsedCursor =
-            (unoidl.com.sun.star.sheet.XUsedAreaCursor) xCursor;
-        xUsedCursor.gotoStartOfUsedArea( false );
-        xUsedCursor.gotoEndOfUsedArea( true );
-        // xUsedCursor and xCursor are interfaces of the same object -
-        // so modifying xUsedCursor takes effect on xCursor:
-        Console.WriteLine(
-            "The used area is: " + getCellRangeAddressString( xCursor, true ) );
-    }
-
-// ________________________________________________________________
-
-    /** All samples regarding the formatting of cells and ranges. */
-    private void doFormattingSamples()
-    {
-        Console.WriteLine( "\n*** Formatting samples ***\n" );
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet = getSpreadsheet( 1 );
-        unoidl.com.sun.star.table.XCellRange xCellRange;
-        unoidl.com.sun.star.beans.XPropertySet xPropSet = null;
-        unoidl.com.sun.star.container.XIndexAccess xRangeIA = null;
-        unoidl.com.sun.star.lang.XMultiServiceFactory xServiceManager;
-
-
-        // --- Cell styles ---
-        // get the cell style container
-        unoidl.com.sun.star.style.XStyleFamiliesSupplier xFamiliesSupplier =
-            (unoidl.com.sun.star.style.XStyleFamiliesSupplier) getDocument();
-        unoidl.com.sun.star.container.XNameAccess xFamiliesNA =
-            xFamiliesSupplier.getStyleFamilies();
-        uno.Any aCellStylesObj = xFamiliesNA.getByName( "CellStyles" );
-        unoidl.com.sun.star.container.XNameContainer xCellStylesNA =
-            (unoidl.com.sun.star.container.XNameContainer) aCellStylesObj.Value;
-
-        // create a new cell style
-        xServiceManager =
-            (unoidl.com.sun.star.lang.XMultiServiceFactory) getDocument();
-        Object aCellStyle = xServiceManager.createInstance(
-            "com.sun.star.style.CellStyle" );
-        String aStyleName = "MyNewCellStyle";
-        xCellStylesNA.insertByName(
-            aStyleName, new uno.Any( typeof (Object), aCellStyle ) );
-
-        // modify properties of the new style
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) aCellStyle;
-        xPropSet.setPropertyValue(
-            "CellBackColor", new uno.Any( (Int32) 0x888888 ) );
-        xPropSet.setPropertyValue(
-            "IsCellBackgroundTransparent", new uno.Any( false ) );
-
-
-
-        // --- Query equal-formatted cell ranges ---
-        // prepare example, use the new cell style
-        xCellRange = xSheet.getCellRangeByName( "D2:F2" );
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCellRange;
-        xPropSet.setPropertyValue( "CellStyle", new uno.Any( aStyleName ) );
-        
-        xCellRange = xSheet.getCellRangeByName( "A3:G3" );
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCellRange;
-        xPropSet.setPropertyValue( "CellStyle", new uno.Any( aStyleName ) );
-
-        // All ranges in one container
-        xCellRange = xSheet.getCellRangeByName( "A1:G3" );
-        Console.WriteLine( "Service CellFormatRanges:" );
-        unoidl.com.sun.star.sheet.XCellFormatRangesSupplier xFormatSupp =
-            (unoidl.com.sun.star.sheet.XCellFormatRangesSupplier) xCellRange;
-        xRangeIA = xFormatSupp.getCellFormatRanges();
-        Console.WriteLine( getCellRangeListString( xRangeIA ) );
-        
-        // Ranges sorted in SheetCellRanges containers
-        Console.WriteLine( "\nService UniqueCellFormatRanges:" );
-        unoidl.com.sun.star.sheet.XUniqueCellFormatRangesSupplier
-            xUniqueFormatSupp =
-            (unoidl.com.sun.star.sheet.XUniqueCellFormatRangesSupplier)
-              xCellRange;
-        unoidl.com.sun.star.container.XIndexAccess xRangesIA =
-            xUniqueFormatSupp.getUniqueCellFormatRanges();
-        int nCount = xRangesIA.getCount();
-        for (int nIndex = 0; nIndex < nCount; ++nIndex)
-        {
-            uno.Any aRangesObj = xRangesIA.getByIndex( nIndex );
-            xRangeIA =
-                (unoidl.com.sun.star.container.XIndexAccess) aRangesObj.Value;
-            Console.WriteLine(
-                "Container " + (nIndex + 1) + ": " +
-                getCellRangeListString( xRangeIA ) );
-        }
-        
-
-        // --- Table auto formats ---
-        // get the global collection of table auto formats,
-        // use global service manager
-        xServiceManager = getServiceManager();
-        Object aAutoFormatsObj = xServiceManager.createInstance(
-            "com.sun.star.sheet.TableAutoFormats" );
-        unoidl.com.sun.star.container.XNameContainer xAutoFormatsNA =
-            (unoidl.com.sun.star.container.XNameContainer) aAutoFormatsObj;
-        
-        // create a new table auto format and insert into the container
-        String aAutoFormatName =  "Temp_Example";
-        bool bExistsAlready = xAutoFormatsNA.hasByName( aAutoFormatName );
-        uno.Any aAutoFormatObj;
-        if (bExistsAlready)
-            // auto format already exists -> use it
-            aAutoFormatObj = xAutoFormatsNA.getByName( aAutoFormatName );
-        else
-        {
-            // create a new auto format (with document service manager!)
-            xServiceManager =
-                (unoidl.com.sun.star.lang.XMultiServiceFactory) getDocument();
-            aAutoFormatObj = new uno.Any(
-                typeof (Object),
-                xServiceManager.createInstance(
-                    "com.sun.star.sheet.TableAutoFormat" ) );
-            xAutoFormatsNA.insertByName( aAutoFormatName, aAutoFormatObj );
-        }
-        // index access to the auto format fields
-        unoidl.com.sun.star.container.XIndexAccess xAutoFormatIA =
-            (unoidl.com.sun.star.container.XIndexAccess) aAutoFormatObj.Value;
-
-        // set properties of all auto format fields
-        for (int nRow = 0; nRow < 4; ++nRow)
-        {
-            int nRowColor = 0;
-            switch (nRow)
-            {
-                case 0:     nRowColor = 0x999999;   break;
-                case 1:     nRowColor = 0xFFFFCC;   break;
-                case 2:     nRowColor = 0xEEEEEE;   break;
-                case 3:     nRowColor = 0x999999;   break;
-            }
-
-            for (int nColumn = 0; nColumn < 4; ++nColumn)
-            {
-                int nColor = nRowColor;
-                if ((nColumn == 0) || (nColumn == 3))
-                    nColor -= 0x333300;
-
-                // get the auto format field and apply properties
-                uno.Any aFieldObj = xAutoFormatIA.getByIndex(
-                    4 * nRow + nColumn );
-                xPropSet =
-                    (unoidl.com.sun.star.beans.XPropertySet) aFieldObj.Value;
-                xPropSet.setPropertyValue(
-                    "CellBackColor", new uno.Any( (Int32) nColor ) );
-            }
-        }
-
-        // set the auto format to the spreadsheet
-        xCellRange = xSheet.getCellRangeByName( "A5:H25" );
-        unoidl.com.sun.star.table.XAutoFormattable xAutoForm =
-            (unoidl.com.sun.star.table.XAutoFormattable) xCellRange;
-        xAutoForm.autoFormat( aAutoFormatName );
-
-        // remove the auto format
-        if (!bExistsAlready)
-            xAutoFormatsNA.removeByName( aAutoFormatName );
-
-
-        // --- Conditional formats ---
-        xSheet = getSpreadsheet( 0 );
-        prepareRange( xSheet, "K20:K23", "Cond. Format" );
-        setValue( xSheet, "K21", 1 );
-        setValue( xSheet, "K22", 2 );
-        setValue( xSheet, "K23", 3 );
-
-        // get the conditional format object of the cell range
-        xCellRange = xSheet.getCellRangeByName( "K21:K23" );
-        xPropSet = (unoidl.com.sun.star.beans.XPropertySet) xCellRange;
-        unoidl.com.sun.star.sheet.XSheetConditionalEntries xEntries =
-            (unoidl.com.sun.star.sheet.XSheetConditionalEntries)
-              xPropSet.getPropertyValue( "ConditionalFormat" ).Value;
-        
-        // create a condition and apply it to the range
-        unoidl.com.sun.star.beans.PropertyValue[] aCondition =
-            new unoidl.com.sun.star.beans.PropertyValue[3];
-        aCondition[0] = new unoidl.com.sun.star.beans.PropertyValue();
-        aCondition[0].Name  = "Operator";
-        aCondition[0].Value =
-            new uno.Any(
-                typeof (unoidl.com.sun.star.sheet.ConditionOperator),
-                unoidl.com.sun.star.sheet.ConditionOperator.GREATER );
-        aCondition[1] = new unoidl.com.sun.star.beans.PropertyValue();
-        aCondition[1].Name  = "Formula1";
-        aCondition[1].Value = new uno.Any( "1" );
-        aCondition[2] = new unoidl.com.sun.star.beans.PropertyValue();
-        aCondition[2].Name  = "StyleName";
-        aCondition[2].Value = new uno.Any( aStyleName );
-        xEntries.addNew( aCondition );
-        xPropSet.setPropertyValue(
-            "ConditionalFormat",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.sheet.XSheetConditionalEntries),
-                xEntries ) );
-    }
-
-// ________________________________________________________________
-
-    /** All samples regarding the spreadsheet document. */
-    private void doDocumentSamples()
-    {
-        Console.WriteLine( "\n*** Samples for spreadsheet document ***\n" );
-
-
-        // --- Insert a new spreadsheet ---
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet =
-            insertSpreadsheet( "A new sheet", (short) 0x7FFF );
-
-
-        // --- Copy a cell range ---
-        prepareRange( xSheet, "A1:B3", "Copy from" );
-        prepareRange( xSheet, "D1:E3", "To" );
-        setValue( xSheet, "A2", 123 );
-        setValue( xSheet, "B2", 345 );
-        setFormula( xSheet, "A3", "=SUM(A2:B2)" );
-        setFormula( xSheet, "B3", "=FORMULA(A3)" );
-
-        unoidl.com.sun.star.sheet.XCellRangeMovement xMovement =
-            (unoidl.com.sun.star.sheet.XCellRangeMovement) xSheet;
-        unoidl.com.sun.star.table.CellRangeAddress aSourceRange =
-            createCellRangeAddress( xSheet, "A2:B3" );
-        unoidl.com.sun.star.table.CellAddress aDestCell =
-            createCellAddress( xSheet, "D2" );
-        xMovement.copyRange( aDestCell, aSourceRange );
-
-
-        // --- Print automatic column page breaks ---
-        unoidl.com.sun.star.sheet.XSheetPageBreak xPageBreak =
-            (unoidl.com.sun.star.sheet.XSheetPageBreak) xSheet;
-        unoidl.com.sun.star.sheet.TablePageBreakData[] aPageBreakArray =
-            xPageBreak.getColumnPageBreaks();
-
-        Console.Write( "Automatic column page breaks:" );
-        for (int nIndex = 0; nIndex < aPageBreakArray.Length; ++nIndex)
-            if (!aPageBreakArray[nIndex].ManualBreak)
-                Console.Write( " " + aPageBreakArray[nIndex].Position );
-        Console.WriteLine();
-
-
-        // --- Document properties ---
-        unoidl.com.sun.star.beans.XPropertySet xPropSet =
-            (unoidl.com.sun.star.beans.XPropertySet) getDocument();
-        
-        String aText = "Value of property IsIterationEnabled: ";
-        aText +=
-            (Boolean) xPropSet.getPropertyValue( "IsIterationEnabled" ).Value;
-        Console.WriteLine( aText );
-        aText = "Value of property IterationCount: ";
-        aText += (Int32) xPropSet.getPropertyValue( "IterationCount" ).Value;
-        Console.WriteLine( aText );
-        aText = "Value of property NullDate: ";
-        unoidl.com.sun.star.util.Date aDate = (unoidl.com.sun.star.util.Date)
-            xPropSet.getPropertyValue( "NullDate" ).Value;
-        aText += aDate.Year + "-" + aDate.Month + "-" + aDate.Day;
-        Console.WriteLine( aText );
-
-
-        // --- Data validation ---
-        prepareRange( xSheet, "A5:C7", "Validation" );
-        setFormula( xSheet, "A6", "Insert values between 0.0 and 5.0 below:" );
-
-        unoidl.com.sun.star.table.XCellRange xCellRange =
-            xSheet.getCellRangeByName( "A7:C7" );
-        unoidl.com.sun.star.beans.XPropertySet xCellPropSet =
-            (unoidl.com.sun.star.beans.XPropertySet) xCellRange;
-        // validation properties
-        unoidl.com.sun.star.beans.XPropertySet xValidPropSet =
-            (unoidl.com.sun.star.beans.XPropertySet)
-              xCellPropSet.getPropertyValue( "Validation" ).Value;
-        xValidPropSet.setPropertyValue(
-            "Type",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.sheet.ValidationType),
-                unoidl.com.sun.star.sheet.ValidationType.DECIMAL ) );
-        xValidPropSet.setPropertyValue(
-            "ShowErrorMessage", new uno.Any( true ) );
-        xValidPropSet.setPropertyValue(
-            "ErrorMessage", new uno.Any( "This is an invalid value!" ) );
-        xValidPropSet.setPropertyValue(
-            "ErrorAlertStyle",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.sheet.ValidationAlertStyle),
-                unoidl.com.sun.star.sheet.ValidationAlertStyle.STOP ) );
-        // condition
-        unoidl.com.sun.star.sheet.XSheetCondition xCondition =
-            (unoidl.com.sun.star.sheet.XSheetCondition) xValidPropSet;
-        xCondition.setOperator(
-            unoidl.com.sun.star.sheet.ConditionOperator.BETWEEN );
-        xCondition.setFormula1( "0.0" );
-        xCondition.setFormula2( "5.0" );
-        // apply on cell range
-        xCellPropSet.setPropertyValue(
-            "Validation",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.beans.XPropertySet),
-                xValidPropSet ) );
-        
-
-        // --- Scenarios ---
-        uno.Any [][] aValues = {
-            new uno.Any [] { uno.Any.VOID, uno.Any.VOID },
-            new uno.Any [] { uno.Any.VOID, uno.Any.VOID }
-        };
-        
-        aValues[ 0 ][ 0 ] = new uno.Any( (Double) 11 );
-        aValues[ 0 ][ 1 ] = new uno.Any( (Double) 12 );
-        aValues[ 1 ][ 0 ] = new uno.Any( "Test13" );
-        aValues[ 1 ][ 1 ] = new uno.Any( "Test14" );
-        insertScenario(
-            xSheet, "B10:C11", aValues,
-            "First Scenario", "The first scenario." );
-
-        aValues[ 0 ][ 0 ] = new uno.Any( "Test21" );
-        aValues[ 0 ][ 1 ] = new uno.Any( "Test22" );
-        aValues[ 1 ][ 0 ] = new uno.Any( (Double) 23 );
-        aValues[ 1 ][ 1 ] = new uno.Any( (Double) 24 );
-        insertScenario(
-            xSheet, "B10:C11", aValues,
-            "Second Scenario", "The visible scenario." );
-
-        aValues[ 0 ][ 0 ] = new uno.Any( (Double) 31 );
-        aValues[ 0 ][ 1 ] = new uno.Any( (Double) 32 );
-        aValues[ 1 ][ 0 ] = new uno.Any( "Test33" );
-        aValues[ 1 ][ 1 ] = new uno.Any( "Test34" );
-        insertScenario(
-            xSheet, "B10:C11", aValues,
-            "Third Scenario", "The last scenario." );
-
-        // show second scenario
-        showScenario( xSheet, "Second Scenario" );
-    }
-
-    /** Inserts a scenario containing one cell range into a sheet and
-        applies the value array.
-        @param xSheet           The XSpreadsheet interface of the spreadsheet.
-        @param aRange           The range address for the scenario.
-        @param aValueArray      The array of cell contents.
-        @param aScenarioName    The name of the new scenario.
-        @param aScenarioComment The user comment for the scenario. */
-    private void insertScenario(
-            unoidl.com.sun.star.sheet.XSpreadsheet xSheet,
-            String aRange,
-            uno.Any [][] aValueArray,
-            String aScenarioName,
-            String aScenarioComment )
-    {
-        // get the cell range with the given address
-        unoidl.com.sun.star.table.XCellRange xCellRange =
-            xSheet.getCellRangeByName( aRange );
-
-        // create the range address sequence
-        unoidl.com.sun.star.sheet.XCellRangeAddressable xAddr =
-            (unoidl.com.sun.star.sheet.XCellRangeAddressable) xCellRange;
-        unoidl.com.sun.star.table.CellRangeAddress[] aRangesSeq =
-            new unoidl.com.sun.star.table.CellRangeAddress[1];
-        aRangesSeq[0] = xAddr.getRangeAddress();
-
-        // create the scenario
-        unoidl.com.sun.star.sheet.XScenariosSupplier xScenSupp =
-            (unoidl.com.sun.star.sheet.XScenariosSupplier) xSheet;
-        unoidl.com.sun.star.sheet.XScenarios xScenarios =
-            xScenSupp.getScenarios();
-        xScenarios.addNewByName( aScenarioName, aRangesSeq, aScenarioComment );
-
-        // insert the values into the range
-        unoidl.com.sun.star.sheet.XCellRangeData xData =
-            (unoidl.com.sun.star.sheet.XCellRangeData) xCellRange;
-        xData.setDataArray( aValueArray );
-    }
-
-    /** Activates a scenario.
-        @param xSheet           The XSpreadsheet interface of the spreadsheet.
-        @param aScenarioName    The name of the scenario. */
-    private void showScenario(
-            unoidl.com.sun.star.sheet.XSpreadsheet xSheet,
-            String aScenarioName )
-    {
-        // get the scenario set
-        unoidl.com.sun.star.sheet.XScenariosSupplier xScenSupp =
-            (unoidl.com.sun.star.sheet.XScenariosSupplier) xSheet;
-        unoidl.com.sun.star.sheet.XScenarios xScenarios =
-            xScenSupp.getScenarios();
-
-        // get the scenario and activate it
-        uno.Any aScenarioObj = xScenarios.getByName( aScenarioName );
-        unoidl.com.sun.star.sheet.XScenario xScenario =
-            (unoidl.com.sun.star.sheet.XScenario) aScenarioObj.Value;
-        xScenario.apply();
-    }
-
-// ________________________________________________________________
-
-    private void doNamedRangesSamples()
-    {
-        Console.WriteLine( "\n*** Samples for named ranges ***\n" );
-        unoidl.com.sun.star.sheet.XSpreadsheetDocument xDocument =
-            getDocument();
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet =
-            getSpreadsheet( 0 );
-
-
-        // --- Named ranges ---
-        prepareRange( xSheet, "G42:H45", "Named ranges" );
-        xSheet.getCellByPosition( 6, 42 ).setValue( 1 );
-        xSheet.getCellByPosition( 6, 43 ).setValue( 2 );
-        xSheet.getCellByPosition( 7, 42 ).setValue( 3 );
-        xSheet.getCellByPosition( 7, 43 ).setValue( 4 );
-
-        // insert a named range
-        unoidl.com.sun.star.beans.XPropertySet xDocProp =
-            (unoidl.com.sun.star.beans.XPropertySet) xDocument;
-        uno.Any aRangesObj = xDocProp.getPropertyValue( "NamedRanges" );
-        unoidl.com.sun.star.sheet.XNamedRanges xNamedRanges =
-            (unoidl.com.sun.star.sheet.XNamedRanges) aRangesObj.Value;
-        unoidl.com.sun.star.table.CellAddress aRefPos =
-            new unoidl.com.sun.star.table.CellAddress();
-        aRefPos.Sheet  = 0;
-        aRefPos.Column = 6;
-        aRefPos.Row    = 44;
-        xNamedRanges.addNewByName( "ExampleName", "SUM(G43:G44)", aRefPos, 0 );
-
-        // use the named range in formulas
-        xSheet.getCellByPosition( 6, 44 ).setFormula( "=ExampleName" );
-        xSheet.getCellByPosition( 7, 44 ).setFormula( "=ExampleName" );
-
-
-        // --- Label ranges ---
-        prepareRange( xSheet, "G47:I50", "Label ranges" );
-        unoidl.com.sun.star.table.XCellRange xRange =
-            xSheet.getCellRangeByPosition( 6, 47, 7, 49 );
-        unoidl.com.sun.star.sheet.XCellRangeData xData =
-            ( unoidl.com.sun.star.sheet.XCellRangeData ) xRange;
-        uno.Any [][] aValues =
-        {
-            new uno.Any [] { new uno.Any( "Apples" ),
-                             new uno.Any( "Oranges" ) },
-            new uno.Any [] { new uno.Any( (Double) 5 ),
-                             new uno.Any( (Double) 7 ) },
-            new uno.Any [] { new uno.Any( (Double) 6 ),
-                             new uno.Any( (Double) 8 ) }
-        };
-        xData.setDataArray( aValues );
-
-        // insert a column label range
-        uno.Any aLabelsObj = xDocProp.getPropertyValue( "ColumnLabelRanges" );
-        unoidl.com.sun.star.sheet.XLabelRanges xLabelRanges =
-            (unoidl.com.sun.star.sheet.XLabelRanges) aLabelsObj.Value;
-        unoidl.com.sun.star.table.CellRangeAddress aLabelArea =
-            new unoidl.com.sun.star.table.CellRangeAddress();
-        aLabelArea.Sheet       = 0;
-        aLabelArea.StartColumn = 6;
-        aLabelArea.StartRow    = 47;
-        aLabelArea.EndColumn   = 7;
-        aLabelArea.EndRow      = 47;
-        unoidl.com.sun.star.table.CellRangeAddress aDataArea =
-            new unoidl.com.sun.star.table.CellRangeAddress();
-        aDataArea.Sheet       = 0;
-        aDataArea.StartColumn = 6;
-        aDataArea.StartRow    = 48;
-        aDataArea.EndColumn   = 7;
-        aDataArea.EndRow      = 49;
-        xLabelRanges.addNew( aLabelArea, aDataArea );
-
-        // use the label range in formulas
-        xSheet.getCellByPosition( 8, 48 ).setFormula( "=Apples+Oranges" );
-        xSheet.getCellByPosition( 8, 49 ).setFormula( "=Apples+Oranges" );
-    }
-
-// ________________________________________________________________
-
-    /** Helper for doDatabaseSamples: get name of first database. */
-    private String getFirstDatabaseName()
-    {
-        String aDatabase = null;
-        unoidl.com.sun.star.lang.XMultiServiceFactory xServiceManager =
-            getServiceManager();
-        unoidl.com.sun.star.container.XNameAccess xContext =
-            (unoidl.com.sun.star.container.XNameAccess)
-            xServiceManager.createInstance(
-                "com.sun.star.sdb.DatabaseContext" );
-        String[] aNames = xContext.getElementNames();
-        if ( aNames.Length > 0 )
-            aDatabase = aNames[0];
-        return aDatabase;
-    }
-
-    /** Helper for doDatabaseSamples: get name of first table in a database. */
-    private String getFirstTableName( String aDatabase )
-    {
-        if ( aDatabase == null )
-            return null;
-
-        String aTable = null;
-        unoidl.com.sun.star.lang.XMultiServiceFactory xServiceManager =
-            getServiceManager();
-        unoidl.com.sun.star.container.XNameAccess xContext =
-            (unoidl.com.sun.star.container.XNameAccess)
-            xServiceManager.createInstance(
-                "com.sun.star.sdb.DatabaseContext" );
-        unoidl.com.sun.star.sdb.XCompletedConnection xSource =
-            (unoidl.com.sun.star.sdb.XCompletedConnection)
-              xContext.getByName( aDatabase ).Value;
-        unoidl.com.sun.star.task.XInteractionHandler xHandler =
-            (unoidl.com.sun.star.task.XInteractionHandler)
-              xServiceManager.createInstance(
-                  "com.sun.star.sdb.InteractionHandler" );
-         unoidl.com.sun.star.sdbcx.XTablesSupplier xSupplier =
-            (unoidl.com.sun.star.sdbcx.XTablesSupplier)
-              xSource.connectWithCompletion( xHandler );
-        unoidl.com.sun.star.container.XNameAccess xTables =
-            xSupplier.getTables();
-        String[] aNames = xTables.getElementNames();
-        if ( aNames.Length > 0 )
-            aTable = aNames[0];
-        return aTable;
-    }
-
-    private void doDatabaseSamples()
-    {
-        Console.WriteLine( "\n*** Samples for database operations ***\n" );
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet = getSpreadsheet( 2 );
-
-
-        // --- put some example data into the sheet ---
-        unoidl.com.sun.star.table.XCellRange xRange =
-            xSheet.getCellRangeByName( "B3:D24" );
-        unoidl.com.sun.star.sheet.XCellRangeData xData =
-            (unoidl.com.sun.star.sheet.XCellRangeData) xRange;
-        uno.Any [][] aValues =
-        {
-            new uno.Any [] { new uno.Any( "Name" ),
-                             new uno.Any( "Year" ),
-                             new uno.Any( "Sales" ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( (Double) 2001 ),
-                             new uno.Any( (Double) 4.0 ) },
-            new uno.Any [] { new uno.Any( "Carol" ),
-                             new uno.Any( (Double) 1997 ),
-                             new uno.Any( (Double) 3.0 ) },
-            new uno.Any [] { new uno.Any( "Carol" ),
-                             new uno.Any( (Double) 1998 ),
-                             new uno.Any( (Double) 8.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( (Double) 1997 ),
-                             new uno.Any( (Double) 8.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( (Double) 2002 ),
-                             new uno.Any( (Double) 9.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( (Double) 1999 ),
-                             new uno.Any( (Double) 7.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-                             new uno.Any( (Double) 1996 ),
-                             new uno.Any( (Double) 3.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( (Double) 2000 ),
-                             new uno.Any( (Double) 1.0 ) },
-            new uno.Any [] { new uno.Any( "Carol" ),
-                             new uno.Any( (Double) 1999 ),
-                             new uno.Any( (Double) 5.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-                             new uno.Any( (Double) 2002 ),
-                             new uno.Any( (Double) 1.0 ) },
-            new uno.Any [] { new uno.Any( "Carol" ),
-              new uno.Any( (Double) 2001 ),
-              new uno.Any( (Double) 5.0 ) },
-            new uno.Any [] { new uno.Any( "Carol" ),
-              new uno.Any( (Double) 2000 ),
-              new uno.Any( (Double) 1.0 ) },
-            new uno.Any [] { new uno.Any( "Carol" ),
-              new uno.Any( (Double) 1996 ),
-              new uno.Any( (Double) 8.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-              new uno.Any( (Double) 1996 ),
-              new uno.Any( (Double) 7.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-              new uno.Any( (Double) 1997 ),
-              new uno.Any( (Double) 3.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-              new uno.Any( (Double) 2000 ),
-              new uno.Any( (Double) 9.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-              new uno.Any( (Double) 1998 ),
-              new uno.Any( (Double) 1.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-              new uno.Any( (Double) 1999 ),
-              new uno.Any( (Double) 6.0 ) },
-            new uno.Any [] { new uno.Any( "Carol" ),
-              new uno.Any( (Double) 2002 ),
-              new uno.Any( (Double) 8.0 ) },
-            new uno.Any [] { new uno.Any( "Alice" ),
-              new uno.Any( (Double) 1998 ),
-              new uno.Any( (Double) 5.0 ) },
-            new uno.Any [] { new uno.Any( "Bob" ),
-              new uno.Any( (Double) 2001 ),
-              new uno.Any( (Double) 6.0 ) }
-        };
-        xData.setDataArray( aValues );
-
-
-        // --- filter for second column >= 1998 ---
-        unoidl.com.sun.star.sheet.XSheetFilterable xFilter =
-            (unoidl.com.sun.star.sheet.XSheetFilterable) xRange;
-        unoidl.com.sun.star.sheet.XSheetFilterDescriptor xFilterDesc =
-            xFilter.createFilterDescriptor( true );
-        unoidl.com.sun.star.sheet.TableFilterField[] aFilterFields =
-            new unoidl.com.sun.star.sheet.TableFilterField[1];
-        aFilterFields[0] = new unoidl.com.sun.star.sheet.TableFilterField();
-        aFilterFields[0].Field        = 1;
-        aFilterFields[0].IsNumeric    = true;
-        aFilterFields[0].Operator =
-            unoidl.com.sun.star.sheet.FilterOperator.GREATER_EQUAL;
-        aFilterFields[0].NumericValue = 1998;
-        xFilterDesc.setFilterFields( aFilterFields );
-        unoidl.com.sun.star.beans.XPropertySet xFilterProp =
-            (unoidl.com.sun.star.beans.XPropertySet) xFilterDesc;
-        xFilterProp.setPropertyValue(
-            "ContainsHeader", new uno.Any( true ) );
-        xFilter.filter( xFilterDesc );
-
-
-        // --- do the same filter as above, using criteria from a cell range ---
-        unoidl.com.sun.star.table.XCellRange xCritRange =
-            xSheet.getCellRangeByName( "B27:B28" );
-        unoidl.com.sun.star.sheet.XCellRangeData xCritData =
-            (unoidl.com.sun.star.sheet.XCellRangeData) xCritRange;
-        uno.Any [][] aCritValues =
-        {
-            new uno.Any [] { new uno.Any( "Year" ) },
-            new uno.Any [] { new uno.Any( ">= 1998" ) }
-        };
-        xCritData.setDataArray( aCritValues );
-        unoidl.com.sun.star.sheet.XSheetFilterableEx xCriteria =
-            (unoidl.com.sun.star.sheet.XSheetFilterableEx) xCritRange;
-        xFilterDesc = xCriteria.createFilterDescriptorByObject( xFilter );
-        if ( xFilterDesc != null )
-            xFilter.filter( xFilterDesc );
-
-
-        // --- sort by second column, ascending ---
-        unoidl.com.sun.star.util.SortField[] aSortFields =
-            new unoidl.com.sun.star.util.SortField[1];
-        aSortFields[0] = new unoidl.com.sun.star.util.SortField();
-        aSortFields[0].Field         = 1;
-        aSortFields[0].SortAscending = true;
-
-        unoidl.com.sun.star.beans.PropertyValue[] aSortDesc =
-            new unoidl.com.sun.star.beans.PropertyValue[2];
-        aSortDesc[0] = new unoidl.com.sun.star.beans.PropertyValue();
-        aSortDesc[0].Name   = "SortFields";
-        aSortDesc[0].Value  =
-            new uno.Any(
-                typeof (unoidl.com.sun.star.util.SortField []),
-                aSortFields );
-        aSortDesc[1] = new unoidl.com.sun.star.beans.PropertyValue();
-        aSortDesc[1].Name   = "ContainsHeader";
-        aSortDesc[1].Value  = new uno.Any( true );
-
-        unoidl.com.sun.star.util.XSortable xSort =
-            (unoidl.com.sun.star.util.XSortable) xRange;
-        xSort.sort( aSortDesc );
-
-
-        // --- insert subtotals ---
-        unoidl.com.sun.star.sheet.XSubTotalCalculatable xSub =
-            (unoidl.com.sun.star.sheet.XSubTotalCalculatable) xRange;
-        unoidl.com.sun.star.sheet.XSubTotalDescriptor xSubDesc =
-            xSub.createSubTotalDescriptor( true );
-        unoidl.com.sun.star.sheet.SubTotalColumn[] aColumns =
-            new unoidl.com.sun.star.sheet.SubTotalColumn[1];
-        // calculate sum of third column
-        aColumns[0] = new unoidl.com.sun.star.sheet.SubTotalColumn();
-        aColumns[0].Column   = 2;
-        aColumns[0].Function = unoidl.com.sun.star.sheet.GeneralFunction.SUM;
-        // group by first column
-        xSubDesc.addNew( aColumns, 0 );
-        xSub.applySubTotals( xSubDesc, true );
-
-        String aDatabase = getFirstDatabaseName();
-        String aTableName = getFirstTableName( aDatabase );
-        if ( aDatabase != null && aTableName != null )
-        {
-            // --- import from database ---
-            unoidl.com.sun.star.beans.PropertyValue[] aImportDesc =
-                new unoidl.com.sun.star.beans.PropertyValue[3];
-            aImportDesc[0] = new unoidl.com.sun.star.beans.PropertyValue();
-            aImportDesc[0].Name     = "DatabaseName";
-            aImportDesc[0].Value    = new uno.Any( aDatabase );
-            aImportDesc[1] = new unoidl.com.sun.star.beans.PropertyValue();
-            aImportDesc[1].Name     = "SourceType";
-            aImportDesc[1].Value    =
-                new uno.Any(
-                    typeof (unoidl.com.sun.star.sheet.DataImportMode),
-                    unoidl.com.sun.star.sheet.DataImportMode.TABLE );
-            aImportDesc[2] = new unoidl.com.sun.star.beans.PropertyValue();
-            aImportDesc[2].Name     = "SourceObject";
-            aImportDesc[2].Value    = new uno.Any( aTableName );
-
-            unoidl.com.sun.star.table.XCellRange xImportRange =
-                xSheet.getCellRangeByName( "B35:B35" );
-            unoidl.com.sun.star.util.XImportable xImport =
-                (unoidl.com.sun.star.util.XImportable) xImportRange;
-            xImport.doImport( aImportDesc );
-
-
-            // --- use the temporary database range to find the
-            // imported data's size ---
-            unoidl.com.sun.star.beans.XPropertySet xDocProp =
-                (unoidl.com.sun.star.beans.XPropertySet) getDocument();
-            uno.Any aRangesObj = xDocProp.getPropertyValue( "DatabaseRanges" );
-            unoidl.com.sun.star.container.XNameAccess xRanges =
-                (unoidl.com.sun.star.container.XNameAccess) aRangesObj.Value;
-            String[] aNames = xRanges.getElementNames();
-            for ( int i=0; i<aNames.Length; i++ )
-            {
-                uno.Any aRangeObj = xRanges.getByName( aNames[i] );
-                unoidl.com.sun.star.beans.XPropertySet xRangeProp =
-                    (unoidl.com.sun.star.beans.XPropertySet) aRangeObj.Value;
-                bool bUser = (Boolean)
-                    xRangeProp.getPropertyValue( "IsUserDefined" ).Value;
-                if ( !bUser )
-                {
-                    // this is the temporary database range -
-                    // get the cell range and format it
-                    unoidl.com.sun.star.sheet.XCellRangeReferrer xRef =
-                        (unoidl.com.sun.star.sheet.XCellRangeReferrer)
-                          aRangeObj.Value;
-                    unoidl.com.sun.star.table.XCellRange xResultRange =
-                        xRef.getReferredCells();
-                    unoidl.com.sun.star.beans.XPropertySet xResultProp =
-                        (unoidl.com.sun.star.beans.XPropertySet) xResultRange;
-                    xResultProp.setPropertyValue(
-                        "IsCellBackgroundTransparent", new uno.Any( false ) );
-                    xResultProp.setPropertyValue(
-                        "CellBackColor", new uno.Any( (Int32) 0xFFFFCC ) );
-                }
-            }
-        }
-        else
-            Console.WriteLine("can't get database");
-    }
-
-// ________________________________________________________________
-
-    private void doDataPilotSamples()
-    {
-        Console.WriteLine( "\n*** Samples for Data Pilot ***\n" );
-        unoidl.com.sun.star.sheet.XSpreadsheet xSheet = getSpreadsheet( 0 );
-
-
-        // --- Create a new DataPilot table ---
-        prepareRange( xSheet, "A38:C38", "Data Pilot" );
-        unoidl.com.sun.star.sheet.XDataPilotTablesSupplier xDPSupp =
-            (unoidl.com.sun.star.sheet.XDataPilotTablesSupplier) xSheet;
-        unoidl.com.sun.star.sheet.XDataPilotTables xDPTables =
-            xDPSupp.getDataPilotTables();
-        unoidl.com.sun.star.sheet.XDataPilotDescriptor xDPDesc =
-            xDPTables.createDataPilotDescriptor();
-        // set source range (use data range from CellRange test)
-        unoidl.com.sun.star.table.CellRangeAddress aSourceAddress =
-            createCellRangeAddress( xSheet, "A10:C30" );
-        xDPDesc.setSourceRange( aSourceAddress );
-        // settings for fields
-        unoidl.com.sun.star.container.XIndexAccess xFields =
-            xDPDesc.getDataPilotFields();
-        uno.Any aFieldObj;
-        unoidl.com.sun.star.beans.XPropertySet xFieldProp;
-        // use first column as column field
-        aFieldObj = xFields.getByIndex(0);
-        xFieldProp = (unoidl.com.sun.star.beans.XPropertySet) aFieldObj.Value;
-        xFieldProp.setPropertyValue(
-            "Orientation",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.sheet.DataPilotFieldOrientation),
-                unoidl.com.sun.star.sheet.DataPilotFieldOrientation.COLUMN ) );
-        // use second column as row field
-        aFieldObj = xFields.getByIndex(1);
-        xFieldProp = (unoidl.com.sun.star.beans.XPropertySet) aFieldObj.Value;
-        xFieldProp.setPropertyValue(
-            "Orientation",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.sheet.DataPilotFieldOrientation),
-                unoidl.com.sun.star.sheet.DataPilotFieldOrientation.ROW ) );
-        // use third column as data field, calculating the sum
-        aFieldObj = xFields.getByIndex(2);
-        xFieldProp = (unoidl.com.sun.star.beans.XPropertySet) aFieldObj.Value;
-        xFieldProp.setPropertyValue(
-            "Orientation",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.sheet.DataPilotFieldOrientation),
-                unoidl.com.sun.star.sheet.DataPilotFieldOrientation.DATA ) );
-        xFieldProp.setPropertyValue(
-            "Function",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.sheet.GeneralFunction),
-                unoidl.com.sun.star.sheet.GeneralFunction.SUM ) );
-        // select output position
-        unoidl.com.sun.star.table.CellAddress aDestAddress =
-            createCellAddress( xSheet, "A40" );
-        xDPTables.insertNewByName( "DataPilotExample", aDestAddress, xDPDesc );
-
-
-        // --- Modify the DataPilot table ---
-        uno.Any aDPTableObj = xDPTables.getByName( "DataPilotExample" );
-        xDPDesc =
-            (unoidl.com.sun.star.sheet.XDataPilotDescriptor) aDPTableObj.Value;
-        xFields = xDPDesc.getDataPilotFields();
-        // add a second data field from the third column,
-        // calculating the average
-        aFieldObj = xFields.getByIndex(2);
-        xFieldProp = (unoidl.com.sun.star.beans.XPropertySet) aFieldObj.Value;
-        xFieldProp.setPropertyValue(
-            "Orientation",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.sheet.DataPilotFieldOrientation),
-                unoidl.com.sun.star.sheet.DataPilotFieldOrientation.DATA ) );
-        xFieldProp.setPropertyValue(
-            "Function",
-            new uno.Any(
-                typeof (unoidl.com.sun.star.sheet.GeneralFunction),
-                unoidl.com.sun.star.sheet.GeneralFunction.AVERAGE ) );
-    }
-
-// ________________________________________________________________
-
-    private void doFunctionAccessSamples()
-    {
-        Console.WriteLine( "\n*** Samples for function handling ***\n" );
-        unoidl.com.sun.star.lang.XMultiServiceFactory xServiceManager =
-            getServiceManager();
-
-
-        // --- Calculate a function ---
-        Object aFuncInst = xServiceManager.createInstance(
-            "com.sun.star.sheet.FunctionAccess" );
-        unoidl.com.sun.star.sheet.XFunctionAccess xFuncAcc =
-            (unoidl.com.sun.star.sheet.XFunctionAccess) aFuncInst;
-        // put the data in a two-dimensional array
-        Double [][] aData = { new Double [] { 1.0, 2.0, 3.0 } };
-        // construct the array of function arguments
-        uno.Any [] aArgs = new uno.Any [2];
-        aArgs[0] = new uno.Any( typeof (Double [][]), aData );
-        aArgs[1] = new uno.Any( (Double) 2.0 );
-        uno.Any aResult = xFuncAcc.callFunction( "ZTEST", aArgs );
-        Console.WriteLine(
-            "ZTEST result for data {1,2,3} and value 2 is " + aResult.Value );
-
-
-        // --- Get the list of recently used functions ---
-        Object aRecInst = xServiceManager.createInstance(
-            "com.sun.star.sheet.RecentFunctions" );
-        unoidl.com.sun.star.sheet.XRecentFunctions xRecFunc =
-            (unoidl.com.sun.star.sheet.XRecentFunctions) aRecInst;
-        int[] nRecentIds = xRecFunc.getRecentFunctionIds();
-
-
-        // --- Get the names for these functions ---
-        Object aDescInst = xServiceManager.createInstance(
-            "com.sun.star.sheet.FunctionDescriptions" );
-        unoidl.com.sun.star.sheet.XFunctionDescriptions xFuncDesc =
-            (unoidl.com.sun.star.sheet.XFunctionDescriptions) aDescInst;
-        Console.Write("Recently used functions: ");
-        for (int nFunction=0; nFunction<nRecentIds.Length; nFunction++)
-        {
-            unoidl.com.sun.star.beans.PropertyValue[] aProperties =
-                xFuncDesc.getById( nRecentIds[nFunction] );
-            for (int nProp=0; nProp<aProperties.Length; nProp++)
-                if ( aProperties[nProp].Name.Equals( "Name" ) )
-                    Console.Write( aProperties[nProp].Value + " " );
-        }
-        Console.WriteLine();
-    }
-
-// ________________________________________________________________
-
-    private void doApplicationSettingsSamples()
-    {
-        Console.WriteLine( "\n*** Samples for application settings ***\n" );
-        unoidl.com.sun.star.lang.XMultiServiceFactory xServiceManager =
-            getServiceManager();
-
-
-        // --- Get the user defined sort lists ---
-        Object aSettings = xServiceManager.createInstance(
-            "com.sun.star.sheet.GlobalSheetSettings" );
-        unoidl.com.sun.star.beans.XPropertySet xPropSet =
-            (unoidl.com.sun.star.beans.XPropertySet) aSettings;
-        String[] aEntries = (String [])
-            xPropSet.getPropertyValue( "UserLists" ).Value;
-        Console.WriteLine("User defined sort lists:");
-        for ( int i=0; i<aEntries.Length; i++ )
-            Console.WriteLine( aEntries[i] );
-    }
-
-// ________________________________________________________________
-
-}
diff --git a/test/mono/ViewSample.cs b/test/mono/ViewSample.cs
deleted file mode 100644
index 7b73d178f..000000000
--- a/test/mono/ViewSample.cs
+++ /dev/null
@@ -1,165 +0,0 @@
-
-using System;
-using System.Threading;
-
-// __________  implementation  ____________________________________
-
-/** Create and modify a spreadsheet view.
- */
-public class ViewSample : SpreadsheetDocHelper
-{
-
-    public static void Main( String [] args )
-    {
-        try
-        {
-            using ( ViewSample aSample = new ViewSample( args ) )
-            {
-                aSample.doSampleFunction();
-            }
-            Console.WriteLine( "\nSamples done." );
-        }
-        catch (Exception ex)
-        {
-            Console.WriteLine( "Sample caught exception! " + ex );
-        }
-    }
-
-// ________________________________________________________________
-
-    public ViewSample( String[] args )
-        : base( args )
-    {
-    }
-    
-// ________________________________________________________________
-
-    /** This sample function performs all changes on the view. */
-    public void doSampleFunction()
-    {
-        unoidl.com.sun.star.sheet.XSpreadsheetDocument xDoc = getDocument();
-        unoidl.com.sun.star.frame.XModel xModel =
-            (unoidl.com.sun.star.frame.XModel) xDoc;
-        unoidl.com.sun.star.frame.XController xController =
-            xModel.getCurrentController();
- 
-        // --- Spreadsheet view ---
-        // freeze the first column and first two rows
-        unoidl.com.sun.star.sheet.XViewFreezable xFreeze =
-            (unoidl.com.sun.star.sheet.XViewFreezable) xController;
-        if ( null != xFreeze )
-            Console.WriteLine( "got xFreeze" );
-        xFreeze.freezeAtPosition( 1, 2 );
-
-        // --- View pane ---
-        // get the cell range shown in the second pane and assign
-        // a cell background to them
-        unoidl.com.sun.star.container.XIndexAccess xIndex =
-            (unoidl.com.sun.star.container.XIndexAccess) xController;
-        uno.Any aPane = xIndex.getByIndex(1);
-        unoidl.com.sun.star.sheet.XCellRangeReferrer xRefer =
-            (unoidl.com.sun.star.sheet.XCellRangeReferrer) aPane.Value;
-        unoidl.com.sun.star.table.XCellRange xRange = xRefer.getReferredCells();
-        unoidl.com.sun.star.beans.XPropertySet xRangeProp =
-            (unoidl.com.sun.star.beans.XPropertySet) xRange;
-        xRangeProp.setPropertyValue(
-            "IsCellBackgroundTransparent", new uno.Any( false ) );
-        xRangeProp.setPropertyValue(
-            "CellBackColor", new uno.Any( (Int32) 0xFFFFCC ) );
- 
-        // --- View settings ---
-        // change the view to display green grid lines
-        unoidl.com.sun.star.beans.XPropertySet xProp =
-            (unoidl.com.sun.star.beans.XPropertySet) xController;
-        xProp.setPropertyValue(
-            "ShowGrid", new uno.Any( true ) );
-        xProp.setPropertyValue(
-            "GridColor", new uno.Any( (Int32) 0x00CC00 ) );
-
-        // --- Range selection ---
-        // let the user select a range and use it as the view's selection
-        unoidl.com.sun.star.sheet.XRangeSelection xRngSel =
-            (unoidl.com.sun.star.sheet.XRangeSelection) xController;
-        ExampleRangeListener aListener = new ExampleRangeListener();
-        xRngSel.addRangeSelectionListener( aListener );
-        unoidl.com.sun.star.beans.PropertyValue[] aArguments =
-            new unoidl.com.sun.star.beans.PropertyValue[2];
-        aArguments[0] = new unoidl.com.sun.star.beans.PropertyValue();
-        aArguments[0].Name   = "Title";
-        aArguments[0].Value  = new uno.Any( "Please select a range" );
-        aArguments[1] = new unoidl.com.sun.star.beans.PropertyValue();
-        aArguments[1].Name   = "CloseOnMouseRelease";
-        aArguments[1].Value  = new uno.Any( true );
-        xRngSel.startRangeSelection( aArguments );
-        Monitor.Enter( aListener );
-        try
-        {
-            Monitor.Wait( aListener );       // wait until the selection is done
-        }
-        finally
-        {
-            Monitor.Exit( aListener );
-        }
-        xRngSel.removeRangeSelectionListener( aListener );
-        if ( aListener.aResult != null && aListener.aResult.Length != 0 )
-        {
-            unoidl.com.sun.star.view.XSelectionSupplier xSel =
-                (unoidl.com.sun.star.view.XSelectionSupplier) xController;
-            unoidl.com.sun.star.sheet.XSpreadsheetView xView =
-                (unoidl.com.sun.star.sheet.XSpreadsheetView) xController;
-            unoidl.com.sun.star.sheet.XSpreadsheet xSheet =
-                xView.getActiveSheet();
-            unoidl.com.sun.star.table.XCellRange xResultRange =
-                xSheet.getCellRangeByName( aListener.aResult );
-            xSel.select(
-                new uno.Any(
-                    typeof (unoidl.com.sun.star.table.XCellRange),
-                    xResultRange ) );
-        }
-    }
-
-// ________________________________________________________________
-
-    //  listener to react on finished selection
-
-    private class ExampleRangeListener
-        : unoidl.com.sun.star.sheet.XRangeSelectionListener
-    {
-        public String aResult;
-
-        public void done( unoidl.com.sun.star.sheet.RangeSelectionEvent aEvent )
-        {
-            aResult = aEvent.RangeDescriptor;
-            Monitor.Enter( this );
-            try
-            {
-                Monitor.Pulse( this );
-            }
-            finally
-            {
-                Monitor.Exit( this );
-            }
-        }
-
-        public void aborted(
-            unoidl.com.sun.star.sheet.RangeSelectionEvent aEvent )
-        {
-            Monitor.Enter( this );
-            try
-            {
-                Monitor.Pulse( this );
-            }
-            finally
-            {
-                Monitor.Exit( this );
-            }
-        }
-
-        public void disposing( unoidl.com.sun.star.lang.EventObject aObj )
-        {
-        }
-    }
-
-// ________________________________________________________________
-
-}
diff --git a/test/ooxml/.gitignore b/test/ooxml/.gitignore
deleted file mode 100644
index 620eeb8e5..000000000
--- a/test/ooxml/.gitignore
+++ /dev/null
@@ -1,3 +0,0 @@
-*.log
-log
-out
diff --git a/test/ooxml/run.sh b/test/ooxml/run.sh
deleted file mode 100755
index a0e5d1f81..000000000
--- a/test/ooxml/run.sh
+++ /dev/null
@@ -1,149 +0,0 @@
-#!/usr/bin/env sh
-
-ooinstall=$1
-TOOLSDIR=$2
-
-. "$TOOLSDIR/bin/setup" >/dev/null 2>&1
-
-RUN_LOG=`dirname "$0"`/run.log
-touch "$RUN_LOG"
-
-if test -e "$RUN_LOG"; then
-    rm "$RUN_LOG"
-fi
-
-LOGS=`dirname "$0"`/log
-OUTDIR=`dirname "$0"`/out
-
-function show_progress()
-{
-    msg="$1: $2%"
-    i=0
-    backs=
-    while test $((i<${#msg})) == 1; do
-        backs=$backs
-        let i++
-    done
-    unset i
-    echo -en $msg$backs
-}
-
-function get_deps()
-{
-    # The test data
-    cd "$CLONEDIR"
-    if test -d test-files ;then
-        cd test-files
-        git pull -r >>"$RUN_LOG" 2>&1
-    else
-        git clone $OOO_GIT/contrib/test-files >>"$RUN_LOG" 2>&1
-    fi
-
-    #OfficeOTron
-    cd "$CLONEDIR"
-    if test -d officeotron ; then
-        cd officeotron
-        svn update >>"$RUN_LOG" 2>&1
-    else
-        svn checkout http://officeotron.googlecode.com/svn/trunk/ officeotron >>"$RUN_LOG" 2>&1
-    fi
-
-    # Make / update the officeotrong jar file
-    cd "$CLONEDIR/officeotron"
-    ant application >>"$RUN_LOG" 2>&1
-
-    # Get the version
-    OFFICEOTRON_VERSION=`cat build.xml | grep 'name="version"' | sed -e 's:.*name="version"\ value="\([^"]\+\)".*:\1:'`
-    OFFICEOTRON="java -jar $CLONEDIR/officeotron/dist/officeotron-$OFFICEOTRON_VERSION.jar"
-}
-
-function validate()
-{
-    FILE_LOG=$LOGS/`basename $1`.log
-
-    mkdir -p `dirname "$FILE_LOG"`
-
-    SUMMARY_LOG=$LOGS/validations.log
-    if test ! -a "$SUMMARY_LOG"; then
-        touch "$SUMMARY_LOG"
-    fi
-    $OFFICEOTRON --errors-only $1 >"$FILE_LOG" 2>&1
-
-    # Need to save a log for each file and a summary log
-    STATUS="FAILED"
-    RESULT=0
-    LINES_COUNT=`cat "$FILE_LOG" | wc -l`
-    if test "$LINES_COUNT" == "0"; then
-        STATUS="PASSED"
-        RESULT=1
-        rm "$FILE_LOG"
-    fi
-
-    echo -e "$1:\t$STATUS" >>"$SUMMARY_LOG"
-    return $RESULT
-}
-
-function batch_convert()
-{
-    MAX_LOT=100
-    files_lot=
-    lot_size=0
-    for file in $4; do
-        files_lot+=" $file"
-        let lot_size++
-        if test "$lot_size" == "$MAX_LOT"; then
-            echo "\"$ooinstall/program/soffice\" -infilter=\"$1\" -convert-to \"$2\" -outdir $3 $files_lot" >>"$RUN_LOG"
-            "$ooinstall/program/soffice" -infilter="$1" -convert-to "$2" -outdir "$3" $files_lot >>"$RUN_LOG" 2>&1
-            files_lot=
-            lot_size=0
-        fi
-    done
-
-    if test "$lot_size" != "0"; then
-        echo "\"$ooinstall/program/soffice\" -infilter=\"$1\" -convert-to "$2" -outdir "$3" $files_lot" >>"$RUN_LOG"
-        "$ooinstall/program/soffice" -infilter="$1" -convert-to "$2" -outdir "$3" $files_lot >>"$RUN_LOG" 2>&1
-    fi
-}
-
-# Clean the previous results
-if test -d "$OUTDIR"; then
-    rm -r "$OUTDIR"
-fi
-if test -d "$LOGS"; then
-    rm -r "$LOGS"
-fi
-
-# Make sure we have the dependencies
-get_deps
-
-# Generate the test files
-TEST_FILES_DIR=$CLONEDIR/test-files
-cd "$TEST_FILES_DIR" && make >>"$RUN_LOG" 2>&1
-cd "$OLDPWD"
-
-# Load and save the test files
-if test -e "$ooinstall/program/ooenv"; then
-    . "$ooinstall/program/ooenv"
-fi
-
-batch_convert 'Office Open XML Text' 'docx:Office Open XML Text' "$OUTDIR" "$TEST_FILES_DIR/ooxml-strict/tmp/*.docx"
-batch_convert 'Calc Office Open XML' 'xlsx:Calc Office Open XML' "$OUTDIR" "$TEST_FILES_DIR/ooxml-strict/tmp/*.xlsx"
-batch_convert 'Impress Office Open XML' 'pptx:Impress Office Open XML' "$OUTDIR" "$TEST_FILES_DIR/ooxml-strict/tmp/*.pptx"
-
-# Validate the test files
-RESULT=0
-out_count=`ls -1 "$OUTDIR" | wc -l`
-validated=0
-show_progress "Validation" $validated
-for f in `ls "$OUTDIR"`; do
-    validate "$OUTDIR/$f"
-    if test $? != 0; then
-        RESULT=1
-    fi
-    let validated++
-    let rate=validated*100/out_count
-    show_progress "Validation" $rate
-done
-
-
-exit $RESULT
diff --git a/test/qpro/ALIGNMEN.WB2 b/test/qpro/ALIGNMEN.WB2
deleted file mode 100644
index 05a7aebbe..000000000
--- a/test/qpro/ALIGNMEN.WB2
+++ /dev/null
diff --git a/test/qpro/FON.WB2 b/test/qpro/FON.WB2
deleted file mode 100644
index 92da7355a..000000000
--- a/test/qpro/FON.WB2
+++ /dev/null
diff --git a/test/qpro/STRING.WB2 b/test/qpro/STRING.WB2
deleted file mode 100644
index b6dcf5ec1..000000000
--- a/test/qpro/STRING.WB2
+++ /dev/null
diff --git a/test/qpro/blank.wb2 b/test/qpro/blank.wb2
deleted file mode 100644
index d59f60cfb..000000000
--- a/test/qpro/blank.wb2
+++ /dev/null
diff --git a/test/qpro/complex-a.png b/test/qpro/complex-a.png
deleted file mode 100644
index d69bce597..000000000
--- a/test/qpro/complex-a.png
+++ /dev/null
diff --git a/test/qpro/complex-a.xls b/test/qpro/complex-a.xls
deleted file mode 100644
index c7742271c..000000000
--- a/test/qpro/complex-a.xls
+++ /dev/null
diff --git a/test/qpro/complex-b.png b/test/qpro/complex-b.png
deleted file mode 100644
index 2d79f9dab..000000000
--- a/test/qpro/complex-b.png
+++ /dev/null
diff --git a/test/qpro/complex-b.xls b/test/qpro/complex-b.xls
deleted file mode 100644
index 580008d7f..000000000
--- a/test/qpro/complex-b.xls
+++ /dev/null
diff --git a/test/qpro/complex.wb2 b/test/qpro/complex.wb2
deleted file mode 100644
index 66895b892..000000000
--- a/test/qpro/complex.wb2
+++ /dev/null
diff --git a/test/qpro/formula.wb2 b/test/qpro/formula.wb2
deleted file mode 100644
index 61af5eed8..000000000
--- a/test/qpro/formula.wb2
+++ /dev/null
diff --git a/test/qpro/formulat.wb2 b/test/qpro/formulat.wb2
deleted file mode 100644
index 58cc2ddf8..000000000
--- a/test/qpro/formulat.wb2
+++ /dev/null
diff --git a/test/qpro/functions.wb2 b/test/qpro/functions.wb2
deleted file mode 100644
index 1f0db5bff..000000000
--- a/test/qpro/functions.wb2
+++ /dev/null
diff --git a/test/qpro/simple.wb2 b/test/qpro/simple.wb2
deleted file mode 100644
index 9c0f15ff3..000000000
--- a/test/qpro/simple.wb2
+++ /dev/null
diff --git a/test/writer/bullet-test.odt b/test/writer/bullet-test.odt
deleted file mode 100644
index e05da8a4d..000000000
--- a/test/writer/bullet-test.odt
+++ /dev/null
diff --git a/test/writer/enumerate.sxw b/test/writer/enumerate.sxw
deleted file mode 100644
index 9e0a2d771..000000000
--- a/test/writer/enumerate.sxw
+++ /dev/null